Text to Rows Macro : Subscript out of range

[bhrigu]

Hi Guys,

I am trying to perform a text to rows for comma delimited column entries. I have included the screenshot of the raw data and the clean data. I am also including my code and a screenshot of it in the excel vba window. If you could please guide me with what I am doing wrong I would really appreciate it.

Please assume columns B and C are switched around. I forgot to make that change!

231482314923150

[mancubus]

post your workbook pls.

[Toubkal]

Hi all,

Please try this code, I tried to reproduce your situation. I intentionally left an empty cell.
I hope this helps.



Sub Main()
Dim I, J, Temp, LastRaw
Dim RawD, CleanD As Worksheet

Set RawD = ThisWorkbook.Sheets("RawData")
Set CleanD = ThisWorkbook.Sheets("CleanedData")

For I = 1 To RawD.Range("C" & Rows.Count).End(xlUp).Row

LastRaw = CleanD.Range("A" & Rows.Count).End(xlUp).Row + 1 'Last raw to write after
If Not IsEmpty(Range("C" & I)) Then 'avoid empty cells
Temp = Split(Range("C" & I), ",")
For J = LastRaw To UBound(Temp) + LastRaw
CleanD.Cells(J, 1) = RawD.Cells(I, 1) 'to copy the cells in columns A and B
CleanD.Cells(J, 2) = RawD.Cells(I, 2) '************************************
CleanD.Cells(J, 3) = Temp(J - LastRaw) 'We write the value in the CleanedData sheet
Next J
Else
CleanD.Cells(LastRaw, 1) = RawD.Cells(I, 1) 'to copy the cells in columns A and B
CleanD.Cells(LastRaw, 2) = RawD.Cells(I, 2) '************************************
End If
Next I
End Sub

2315223153

[Paul_Hossler]

I usually have to test the upper bound when I use Split() and there's a chance of no data or no separator





Option Explicit
Sub test()
Dim s As String
Dim v As Variant

s = "Has a Comma, In String"
v = Split(s, ",")
MsgBox v(0)
MsgBox v(1)

s = "No Comma Here"
v = Split(s, ",")

If UBound(v) > 0 Then
MsgBox v(0)
MsgBox v(1)
Else
MsgBox v(0)
End If
s = ""
v = Split(s, ",")

If UBound(v) > 0 Then
MsgBox v(0)
MsgBox v(1)
ElseIf UBound(v) = -1 Then
MsgBox "Empty string"
Else
MsgBox v(0)
End If

End Sub

[bhrigu]

Hi all,

Thank you so much for your help. I cant figure out how I would attach an excel workbook here, so I am literally pasting everything here. Please excuse me. I am sure there is a better way I cant figure out.

I need to perform a text to row using columns F and T.

[Paul_Hossler]

At the bottom right, click [Go Advanced] and hen the 'paperclip' icon to first "Add Files", then "Browse" then "Upload"

Make sure to remove or replace any personal, sensitive, confidential, or proprietary information first

[bhrigu]

I have updated my previous comment to attach the file I need to automate. Thank you so much in advance.

[Paul_Hossler]

A2 has 2 names and T2 has 5 organizations

Do you want 2 cleaned rows with
Name#1, ...5 orgs
Name#2 … 5 orgs

Or 10 rows with all combanations (2 x 5 = 10)?

[Toubkal]

It would be better if you send an example of cleaned data for row 2. What to expect for F2 and T2 as Paul said (2 names vs 5 orgs.)

[bhrigu]

A2 has 2 names and T2 has 5 organizations

Do you want 2 cleaned rows with
Name#1, ...5 orgs
Name#2 … 5 orgs

Or 10 rows with all combanations (2 x 5 = 10)?


I apologize for not explaining this better. We want 10 rows with all combinations (2 x 5 = 10)?

For eg. for row 6, which looks like this:



8044
9/7/2016
Frank Kauffman
GRC
Continuation
Amy, Robin
O&E - R&T
1
Processed
Finished
High






C&M
Customer NMA
2q, 23s, 4d, 9s
Phase 2 scope execution complete
8/29/2016 9:00
8/29/2016 9:00


we want it like




8044
9/7/2016
Frank Kauffman
GRC
Continuation
Amy
O&E - R&T
1
Processed
Finished
High






C&M
Customer NMA
2q
Phase 2 scope execution complete
8/29/2016 9:00
8/29/2016 9:00




8044
9/7/2016
Frank Kauffman
GRC
Continuation
Amy
O&E - R&T
1
Processed
Finished
High






C&M
Customer NMA
23s
Phase 2 scope execution complete
8/29/2016 9:00
8/29/2016 9:00





8044
9/7/2016
Frank Kauffman
GRC
Continuation
Amy
O&E - R&T
1
Processed
Finished
High






C&M
Customer NMA
4d
Phase 2 scope execution complete
8/29/2016 9:00
8/29/2016 9:00







8044
9/7/2016
Frank Kauffman
GRC
Continuation
Amy
O&E - R&T
1
Processed
Finished
High






C&M
Customer NMA
9s
Phase 2 scope execution complete
8/29/2016 9:00
8/29/2016 9:00







8044
9/7/2016
Frank Kauffman
GRC
Continuation
Robin
O&E - R&T
1
Processed
Finished
High






C&M
Customer NMA
2q
Phase 2 scope execution complete
8/29/2016 9:00
8/29/2016 9:00







8044
9/7/2016
Frank Kauffman
GRC
Continuation
Robin
O&E - R&T
1
Processed
Finished
High






C&M
Customer NMA
23s
Phase 2 scope execution complete
8/29/2016 9:00
8/29/2016 9:00







8044
9/7/2016
Frank Kauffman
GRC
Continuation
Robin
O&E - R&T
1
Processed
Finished
High






C&M
Customer NMA
4d
Phase 2 scope execution complete
8/29/2016 9:00
8/29/2016 9:00






8044
9/7/2016
Frank Kauffman
GRC
Continuation
Robin
O&E - R&T
1
Processed
Finished
High






C&M
Customer NMA
9s
Phase 2 scope execution complete
8/29/2016 9:00
8/29/2016 9:00

[Paul_Hossler]

This isn't the fastest but it is the most straight-forward






Option Explicit

Sub Raw2Cleaned()
Dim wsRaw As Worksheet, wsClean As Worksheet
Dim f As Long, t As Long, rowClean As Long, rowRaw As Long
Dim aryF As Variant, aryT As Variant

Application.ScreenUpdating = False

Set wsRaw = Worksheets("RawData")
Set wsClean = Worksheets("CleanedData")

wsClean.Cells.Clear
wsRaw.Rows(1).Copy wsClean.Rows(1)
rowClean = 2

For rowRaw = 2 To wsRaw.Cells(1, 1).CurrentRegion.Rows.Count

Application.StatusBar = rowRaw

With wsRaw.Rows(rowRaw)
aryF = Split(.Cells(6).Value, ",")
aryT = Split(.Cells(20).Value, ",")

For f = LBound(aryF) To UBound(aryF)
For t = LBound(aryT) To UBound(aryT)
.Copy wsClean.Rows(rowClean)
wsClean.Cells(rowClean, 6) = aryF(f)
wsClean.Cells(rowClean, 20) = aryT(t)
rowClean = rowClean + 1
Next t
Next f
End With

DoEvents

Next rowRaw

Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

[Toubkal]

Hi,

Try this code, it's similar to the code above but taking into account blank cells.
If a cell in column F is empty: it just copies the entire line and continues to next line.
If a cell in column T is empty: it does text to rows for each name in column F (w/ empty cells in T)



Sub Main()
Dim I, J, K, TempF, TempT
Dim RawD, CleanD As Worksheet
Set RawD = ThisWorkbook.Sheets("RawData")
Set CleanD = ThisWorkbook.Sheets("CleanedData")
CleanD.Cells.Clear
Application.ScreenUpdating = False

LastRow = CleanD.Range("A" & Rows.Count).End(xlUp).Row
For I = 1 To RawD.Range("A" & Rows.Count).End(xlUp).Row

If IsEmpty(Range("F" & I)) Then 'no data in F --> copy entire line and continue, in case you want to do text to rows for each data in T, just replace 1 & 2 with MOD code below.
RawD.Rows(I).Copy CleanD.Rows(LastRow) '1
LastRow = LastRow + 1 '2
ElseIf IsEmpty(Range("T" & I)) Then 'no data in T --> do text to rows for each name in F cell with empty cells in F column.
TempF = Split(Range("F" & I), ",")
For J = LBound(TempF) To UBound(TempF)
RawD.Rows(I).Copy CleanD.Rows(LastRow)
CleanD.Cells(LastRow, 6) = TempF(J)
LastRow = LastRow + 1
Next J
Else 'Do text to rows job for
TempF = Split(Range("F" & I), ",")
TempT = Split(Range("T" & I), ",")
For J = LBound(TempF) To UBound(TempF)
For K = LBound(TempT) To UBound(TempT)
RawD.Rows(I).Copy CleanD.Rows(LastRow)
CleanD.Cells(LastRow, 6) = TempF(J)
CleanD.Cells(LastRow, 20) = TempT(K)
LastRow = LastRow + 1
Next K
Next J
End If
Next I
Application.ScreenUpdating = True
End Sub



MOD:


TempT = Split(Range("T" & I), ",")
For K = LBound(TempT) To UBound(TempT)
RawD.Rows(I).Copy CleanD.Rows(LastRow)
CleanD.Cells(LastRow, 20) = TempT(K)
LastRow = LastRow + 1
Next K


Tested in your sample file.

Good Luck.:)