Spliiting and tranposing a cell seperated by commas and copying all other info in other collumns

[Vick3479]

This macro works for one work book but wont for another and i dont know why they are the same but have diffrent values in the cell...i keep getting debug on this part of the macro in a diffrent work book "Range("D</SPAN>" & i) = MyArr(0)" please help</SPAN>




Sub VictorMartinez()</SPAN>
Dim MyArr, v As Long, i As Long, LR As Long</SPAN>
Application.ScreenUpdating = False</SPAN>
LR = Range("A" & Rows.Count).End(xlUp).Row</SPAN>

For i = LR To 2 Step -1</SPAN>
MyArr = Split(Range("D</SPAN>" & i), ", ")</SPAN>
Range("D</SPAN>" & i) = MyArr(0)</SPAN>
For v = 1 To UBound(MyArr)</SPAN>
Rows(i + v).Insert xlShiftDown</SPAN>
Range("A" & i + v, "BO</SPAN>" & i + v).Value = Range("A" & i, "BO</SPAN>" & i).Value</SPAN>
Range("D</SPAN>" & i + v) = MyArr(v)</SPAN>
Next v</SPAN>
Next i</SPAN>

Application.ScreenUpdating = True</SPAN>
End Sub</SPAN>

 

[CodeNinja]

Easiest thing I can see here that would break is if a cell in column D did not contain ", ". If that were the case, you would crash at For v = 1 To UBound(MyArr). You may want to add an if / then for the ubound(myArr)... If ubound(MyArr)>0 then... for the remainder of the loop.

 

[CodeNinja]

Another thought... I do not think you can split null or a blank cell. That would probably throw an error. You might want to test for that before you split as well...

 

[Vick3479]

If it does not have a comma it just leaves it alone, and in my instance the cell its transposing will always have somthing in it, as for this ''You may want to add an if / then for the ubound(myArr)... If ubound(MyArr)>0 then... for the remainder of the loop.'' im not understanding what to do to the macro?

 

[CodeNinja]

I mean something like this...

Sub VictorMartinez()
Dim MyArr, v As Long, i As Long, LR As Long
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row

For i = LR To 2 Step -1
    If Range("D" & i) <> "" Then
        MyArr = Split(Range("D" & i), ", ")
        Range("D" & i) = MyArr(0)
        If UBound(MyArr) > 0 Then
            For v = 1 To UBound(MyArr)
                Rows(i + v).Insert xlShiftDown
                Range("A" & i + v, "BO" & i + v).Value = Range("A" & i, "BO" & i).Value
                Range("D" & i + v) = MyArr(v)
            Next v
        End If
    End If
Next i

Application.ScreenUpdating = True
End Sub

 

[Vick3479]

Or if u no another macro i could use...Basically i want Cell D2-D_ to be seperated by commas and transposed, and all the other info in that row copied down into the inserted rows.

 

[Vick3479]

Thank you you are freaking amazing!

 

[Rick Rothstein]

Just thought I would have some fun with this problem... here is a non-looping macro that should do the same thing that CodeNinja's macro does.

Sub ForVictorMartinez()
  Dim LR As Long, Commas As Long
  LR = Cells(Rows.Count, "A").End(xlUp).Row
  Commas = Evaluate("SUM(IF(LEN(D2:D" & LR & "),1+LEN(D2:D" & LR & _
           ")-LEN(SUBSTITUTE(D2:D" & LR & ","","","""")),0))") + 1
  With WorksheetFunction
    Range("A2:A" & Commas) = .Transpose(Split(Join(.Transpose(Evaluate("IF(LEN(A2:A" & LR & _
                             "),REPT(A2:A" & LR & "&CHAR(1),1+LEN(D2:D" & LR & _
                             ")-LEN(SUBSTITUTE(D2:D" & LR & ","","",""""))),"""")")), ""), Chr(1)))
    Range("D2:D" & Commas) = .Transpose(Split(Join(.Transpose(Range("D2:D" & LR)), ", "), ", "))
  End With
End Sub

 

[Vick3479]

Ok so what if i wanted to use this but instead of commas i want it to seperate by periods

 

[CodeNinja]

Change the line


MyArr = Split(Range("D" & i), ", ")

with
MyArr = Split(Range("D" & i), ". ")


</pre>