Convert Text to columns in Excel using VBA for dynamic columns and Rows-CodePudding

I have a report wherein i need to do Text to columns for dynamic columns( columns are usually around 24-30 months). I have used the macro recording to currently perform text to columns only for fixed columns.

Expected result - I need help in getting the below macro code to perform text to columns for multiple columns dynamically

Sample report data layout

Column 1	Column 2	Column 3	Column 4	Column 5	Column 6
Data 1	Data 2	Data 3	Data 4	Data 5	Data 6
Data 1	Data 2	Data 3	Data 4	Data 5	Data 6
Data 1	Data 2	Data 3	Data 4	Data 5	Data 6

Macro Code

Sub Txt2Columns()

Dim Wb1 As Workbook

Set Wb1 = Workbooks.Open("C:\Users\dvaan\Desktop\final_report" & ".xlsx")

Columns("A:A").Select
Range("A2", Range("A2").End(xlDown)).TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, Tab:=True
Columns("B:B").Select
Range("B2", Range("B2").End(xlDown)).TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, Tab:=True
Columns("C:C").Select
Range("C2", Range("C2").End(xlDown)).TextToColumns Destination:=Range("C2"), DataType:=xlDelimited, Tab:=True
Columns("D:D").Select
Range("D2", Range("D2").End(xlDown)).TextToColumns Destination:=Range("D2"), DataType:=xlDelimited, Tab:=True
Columns("E:E").Select
Range("E2", Range("E2").End(xlDown)).TextToColumns Destination:=Range("E2"), DataType:=xlDelimited, Tab:=True
Columns("F:F").Select
Range("F2", Range("F2").End(xlDown)).TextToColumns Destination:=Range("F2"), DataType:=xlDelimited, Tab:=True

Columns("A:F").AutoFit

Wb1.Save
Wb1.Close

End Sub

CodePudding user response：

You should use a loop that continues until finding an empty column. The below loops Until rng = "", where rng is A2, B2, C2 etc, but you may wish to change that depending on how you define what to loop.

Sub Txt2Columns_Answer()

Dim Wb1 As Workbook, rng as Range
Set Wb1 = Workbooks.Open("C:\Users\dvaan\Desktop\final_report" & ".xlsx")
Set rng = WB1.Sheets(1).Range("A2")

Do Until rng = ""
    Range(rng, rng.End(xlDown)).TextToColumns _
        Destination:=rng, _
        DataType:=xlDelimited, _
        Tab:=True
    rng.EntireColumn.Autofit
    Set rng = rng.Offset(0, 1)
Loop

Wb1.Save
Wb1.Close

End Sub

It's worth noting that in my tests of the above, the first iteration of the loop (texttocolumns on A2) overwrites other data in the columns it spreads to.