Untitled

Sub SummarizeColumns()
    Dim lastRow As Long
    lastRow = ActiveSheet.Cells(Rows.Count, "Q").End(xlUp).Row
    Dim col As Long
    col = 17 'Q column
    For i = 4 To lastRow
        Cells(i, "H").Value = "" 'clear existing data in H column
        While Cells(1, col).Value = "VO"
            Cells(i, "H").Value = Cells(i, "H").Value + Cells(i, col+1).Value
            col = col + 2
        Wend
    Next i
End Sub