Question

I am receiving a large file 500k+ lines but all the content is in column A. I need to run a macro that will transpose the data into matrix form but will only create a new row when it finds "KEY*" in the ActiveCell. For example:

| KEY 4759839 | asljhk | 35049 | | sklahksdjf|
| KEY 359     | skj    | 487   |y| 2985789   |

The above data in my file would originally look like this in column A:

KEY 4759839
asljhk
35049

sklahksdjf
KEY 359
skj
487
y
2985789

Considerations:

• Blank cells need to be transposed as well, so the macro cant stop based on emptyCell
• The number of cells between KEY’s is not constant so it actually needs to read the cell to know if it should create a new row
• It can either stop based on say 20 empty cells in a row or prompt for a max row number
• (Optional) It would be nice if there was some sort of visual indicator for the last item in a row so that its possible to tell if the last item(s) were blank cells

I searched around and found a macro that had the same general theme but it went based on every 6 lines and I did not know enough to try to modify it for my case. But in case it helps here it is:

Sub kTest()
    Dim a, w(), i As Long, j As Long, c As Integer
    a = Range([a1], [a500000].End(xlUp))
    ReDim w(1 To UBound(a, 1), 1 To 6)
    j = 1
    For i = 1 To UBound(a, 1)
        c = 1 + (i - 1) Mod 6: w(j, c) = a(i, 1)
        If c = 6 Then j = j + 1
    Next i
    [c1].Resize(j, 6) = w
End Sub

I would greatly appreciate any help you can give me!

Answer 1

Tested and works:

    Sub test()
    Row = 0
    col = 1

    'Find the last not empty cell by selecting the bottom cell and moving up
    Max = Range("A650000").End(xlUp).Row 'Or whatever the last allowed row number is

    'loop through the data
    For i = 1 To Max
        'Check if the left 3 characters of the cell are "KEY" and start a new row if they are
        If (Left(Range("A" & i).Value, 3) = "KEY") Then
             Row = Row + 1
             col = 1
        End If

        Cells(Row, col).Value = Range("A" & i).Value
        If (i > Row) Then
            Range("A" & i).Value = ""
        End If
        col = col + 1

    Next i
End Sub