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 (https://www.mrexcel.com/forum/excel-questions/1103869-vba-read-text-file-update-different-column.html) 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 :thumb.....Millions..... of thanks it worked. :clap:

Regards,
mg.

[Leith Ross]

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