Search code examples
excelvbatext-to-column

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


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

Solution

  • 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.