How can I Separate Data from one column to Multicolumn?

Question

I would like to Separate this below.

to this format

I can separate account first.

I would like the optimize way to run the VBA.

Thank you.

Answer 1

Please, test the next VBA solution. It assumes that the range to be processed exists in A:A column and it returns starting from "F1". The code can be easily adjusted to return anywhere (on the sheet, on a different sheet, on a different workbook).

It uses arrays and working mostly in the memory, dropping the processed result at once, at the end of the code, it should be very fast even for large ranges. It is compatible with any Excel version:

Sub SplitDataPerColums()
  Dim sh As Worksheet, lastR As Long, arr, arrFin, i As Long, j As Long, k As Long, boolOK As Boolean
  
  Set sh = ActiveSheet ' please, use here the necessary sheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  
  arr = sh.Range("A1:A" & lastR).Value2  'place the range in an array for faster processing
  ReDim arrFin(1 To UBound(arr), 1 To 3) 'maximum possible number of rows
  k = 1 'first row of the final array
  
  For i = 1 To UBound(arr)
    If Len(arr(i, 1)) = 8 And left(arr(i, 1), 3) = "ACC" Then
        boolOK = False 'to increment the row variable (k) for the case of an account without values
        arrFin(k, 1) = arr(i, 1): j = 1
        Do While InStr(arr(i + j, 1), ":") > 0
            boolOK = True
            arrFin(k, 2) = arr(i + j, 1)
            arrFin(k, 3) = arr(i + j + 1, 1)
            k = k + 1
            j = j + 2: If i + j > UBound(arr) Then Exit Do
        Loop
        If Not boolOK Then k = k + 1 'for the case of accounts without following values
        i = i + j - 1
    End If
  Next i
  Range("F1").Resize(k - 1, 3).Value2 = arrFin
  
End Sub