Excel -- need help with modifying VBA

Experts:

I need some assistance with modifying some VBA code.

As a picture is worth a thousand words, please see the attached XLS first.   Here's some additional background.
1. Columns C (and B) use a carriage return within a cell
2. I need to split the content of columns C and B into separate rows and then duplicate the content of columns A and D for each newly created row.

The attached XLS successfully splits content of column C (and add content of colums A and D) into subsequent rows.   However, the routine does NOT perform the cleanup process for column B also.  

I have tried to modify the "Range" statement but doesn't seem to work for me.  I also created a 2nd ForLoop but that creates now too many records (based on content of column C, I have 7 records).

My question:  How can I modify the VBA routine so that both columns B and C are split?

Thanks in advance,
EEH

P.S. When running the VBA code, the original "Sheet1" is renamed and the newly created sheet is called "Sheet1".
Cleanup-v02.xlsm
ExpExchHelpAsked:
Who is Participating?
 
Tony PittCommented:
I had worked on your first question, producing the attached, which I think does what you want, but the question had disappeared when I tried to reply to it.  (You'll need to do a bit of tidying up of the code, and making it more general.)  The approach is somewhat different to the one you've taken here, but you may be able to combine the two ...

/T
Cleanup-v01.xlsm
0
 
Tony PittCommented:
I think the problem of getting two many rows is because you're not splitting both cells at the same time.  If you go through all the cells in the range B1:C2 and then split them one at a time, you will end up with too many.  You can to go through the rows one at a time, splitting both the B and C cells at the same time.  While I'm sure you could do that using your approach, I think it would end up more complicated code than my original version above.

/T
0
 
ExpExchHelpAuthor Commented:
That's perfect!!!!

Could you please provide some comments on the VBA code... just in case I needed to insert columns or add additional columns?

Thank you in advance,
EEH
0
 
Saqib Husain, SyedEngineerCommented:
Here is mine

Sub cleanup()
Dim newarray() As String
ReDim newarray(1 To 1, 1 To 1)
For Each cel In Range("C2:C" & Range("C2").End(xlDown).Row)
cellarr1 = Split(cel, vbLf)
cellarr2 = Split(cel.Offset(, 1), vbLf)
If UBound(cellarr1) <> UBound(cellarr2) Then Stop
n = UBound(cellarr1) + 1
If UBound(newarray, 1) = 1 Then
ReDim newarray(1 To 4, 1 To n) As String
Else
ReDim Preserve newarray(1 To 4, 1 To UBound(newarray, 2) + n) As String
End If
For i = 1 To n
newarray(1, UBound(newarray, 2) - n + i) = cel.Offset(, -1)
newarray(2, UBound(newarray, 2) - n + i) = cellarr1(i - 1)
newarray(3, UBound(newarray, 2) - n + i) = cellarr2(i - 1)
newarray(4, UBound(newarray, 2) - n + i) = cel.Offset(, 2)
Next i
Next cel
Range("B2").Resize(UBound(newarray, 2), UBound(newarray, 1)) = WorksheetFunction.Transpose(newarray)
Range("B2").CurrentRegion.EntireRow.AutoFit
    With Range("B2").CurrentRegion.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B2").CurrentRegion.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B2").CurrentRegion.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B2").CurrentRegion.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B2").CurrentRegion.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range("B2").CurrentRegion.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

End Sub

Open in new window

0
 
Tony PittCommented:
I've added some comments so that you can better understand what's going on.

Thinking about it a bit more, it would be more elegant to process the worksheet where it is, rather than copying everything to a new sheet.  That way, you'd avoid having to keep pasting the formatting from the source sheet to the destination.  Without actually working it through, I suspect it would just mean inserting an "Insert Row" each time we start filling in a new row in the sheet, much as you've done in your example above...

/T
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.