VBA - loop help in Seperating the data......

[malleshg24]

Hi Team,


I have a data in Column A of sheet1, I retrieve the data from text file,
in middle somewhere i get lines of Dashes. here task is to seperate the data and paste in different Columns starting C.


From below I want the data in 4 Columns except dashes. Thaks in advance.




ex


AAAA
AAAA
------------
BBBB
BBBB
-------------
CCC
CCC
CCCC
CCC
---------
DDDD
DDD


Regards,
mg

[Leith Ross]

Hello Mallesh24,

Is this a different post than the one you posted at Mr Excel yesterday ?

[malleshg24]

Hi Leith,

Thanks for your help in mr excels post.

That is same post, there I was looking from text data into Seperate Columns in excel.
Now I brought the answer in excel by googling, it will be easy in excel to do testing .

Please assist in seperating data from excels single columns to multiple Columns as per data. Thanks.
It will help me in understanding loop perfectly. Thanks

Regards,
mg

[Leith Ross]

Hello Mallesh24,

Is all of the data in cell "A1" or is each line in a separate row like "A1", "A2", "A3", etc ?

[malleshg24]

Hi Leith,

Data is in each line in a seperate row.. like "A1", "A2", "A3", etc as you mentioned. Thanks in advance !!!

Thanks
mg

[Leith Ross]

Hello malleshg24,This macro worked for me. Try it out on your file's data,

Sub SplitIntoColumns()    Dim Col     As Long    Dim Data    As Variant    Dim Row     As Long    Dim Rng     As Range    Dim RngBeg  As Range    Dim RngEnd  As Range    Dim Wks     As Worksheet                ' // Change the sheet name to match your sheet's name.        Set Wks = ThisWorkbook.Worksheets("Sheet1")                ' // Text starts in cell "A1".        Set RngBeg = Wks.Range("A1")        Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)                Set Rng = Wks.Range(RngBeg, RngEnd)        If RngEnd.Row < RngBeg.Row Then Exit Sub                ReDim Data(0)        Col = 3             ' // Start output in Column 3 "C"        Row = RngBeg.Row                Application.ScreenUpdating = False                    For Each Item In Rng.Value                ' // The line must contain at least 4 hyphens.                If Item Like "----*" Or Row = RngEnd.Row Then                    Wks.Cells(Rng.Row, Col).Resize(UBound(Data), 1).Value = Data                    ReDim Data(0)                    Col = Col + 1                Else                    Data(UBound(Data)) = Item                    ReDim Preserve Data(UBound(Data) + 1)                End If                Row = Row + 1            Next Item                Application.ScreenUpdating = True        End Sub

[Leith Ross]

Hello malleshg24,

This macro worked for me. Try it out on your file's data,

Sub SplitIntoColumns()

    Dim Col     As Long
    Dim Data    As Variant
    Dim Row     As Long
    Dim Rng     As Range
    Dim RngBeg  As Range
    Dim RngEnd  As Range
    Dim Wks     As Worksheet
        
        ' // Change the sheet name to match your sheet's name.
        Set Wks = ThisWorkbook.Worksheets("Sheet1")
        
        ' // Text starts in cell "A1".
        Set RngBeg = Wks.Range("A1")
        Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)
        
        Set Rng = Wks.Range(RngBeg, RngEnd)
        If RngEnd.Row < RngBeg.Row Then Exit Sub
        
        ReDim Data(0)
        Col = 3             ' // Start output in Column 3 "C"
        Row = RngBeg.Row
        
        Application.ScreenUpdating = False
        
            For Each Item In Rng.Value
                ' // The line must contain at least 4 hyphens.
                If Item Like "----*" Or Row = RngEnd.Row Then
                    Wks.Cells(Rng.Row, Col).Resize(UBound(Data), 1).Value = Data
                    ReDim Data(0)
                    Col = Col + 1
                Else
                    Data(UBound(Data)) = Item
                    ReDim Preserve Data(UBound(Data) + 1)
                End If
                Row = Row + 1
            Next Item
        
        Application.ScreenUpdating = True
        
End Sub

[malleshg24]

Hi Leith,

Awesome .....Millions..... of thanks it worked.

Regards,
mg.

[Leith Ross]

Hello malleshg24,You're welcome. Glad I could help.