-2

I am trying to create a macro that will split this below which is in row 1 into multiple columns. A,B,C,D,E,F,G,H,I,J,K,L,M but I have a lot of rows to do this to and so far I have only managed to get it to do row 1 while leaving all other rows untouched.

Here is how each row looks before the macro runs. All rows have different data:

BB1300TN1,"TRNSDOA2JA","A32LF4MQ122016","003261761195","D12MP-100C- 
R","","AD10920010","0","","","777777",06/20/2018,"kbktqf"   

And this is what I need all rows to look like after but for all rows:

   A            B       C    D    E    F    G    H    I    J   K   L   M
BB1300TN1  TRNSDOA2JA  xxx  xxx  xxx  xxx  xxx  xxx  xxx  xxx xxx xxx xxx

Here is the code I'm currently trying to use but like I said it only does row 1 and stops. I need it to keep looping through all rows (usually around 200) and change all.

For Each Sheet In ActiveWorkbook.Worksheets
 If Sheet.Name = "Data" Then
      Sheet.Delete
 End If
 Next Sheet
 Const strFileName = "C:\Jabil\Jabil.TXT"
  Dim wbkS As Workbook
Dim wshS As Worksheet
Dim wshT As Worksheet
Set wshT = Worksheets.Add(After:=Worksheets(Worksheets.Count), Count:=1, 
Type:=xlWorksheet)
wshT.Name = "Data"
On Error Resume Next
Set wbkS = Workbooks.Open(fileName:=strFileName)
Set wshS = wbkS.Worksheets(1)
wshS.UsedRange.Copy Destination:=wshT.Range("A1")
wbkS.Close SaveChanges:=False
If ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
 Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=False, OtherChar _
    :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4 
    ,1), Array(5, _
    1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), 
    Array(11, 1), Array(12 _
    , 1), Array(13, 1)), TrailingMinusNumbers:=True
   Cells.Select
  Cells.EntireColumn.AutoFit
Community
  • 1
  • 1
  • 2
    First of all, get rid of that `On Error Resume Next`. Then remove [those `Select`s](https://stackoverflow.com/q/10714251/445425). After that it will be easier for you to debug your code – chris neilsen Jun 22 '18 at 04:50

1 Answers1

0

Instead of using text to columns, you can feed each cell value in a array and then use 'split'. Try the below code. if you have the source data in column A, it would display the results starting from column B in the same sheet. Later, if you want to get rid of the double quotes, you can always find and replace thru vba.

Dim cel As Range
Dim splitarr As Variant
Dim j As Long
Dim str1 As String

Set rng = ThisWorkbook.Sheets("test").Range("A1:A10") 'change sheet and range as required


For Each cel In rng
  splitarr = Split(cel.Text, ",")
  For j = 0 To UBound(splitarr)
  str1 = splitarr(j)
  ThisWorkbook.Sheets("test").Cells(cel.Row, (cel.Column + j + 1)).Value = str1
  Next
Next
Raji
  • 53
  • 1
  • 8