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

Microsoft ExcelVisual Basic ClassicVB Script

Last Comment

Tony Pitt

8/22/2022 - Mon

ASKER CERTIFIED SOLUTION

Tony Pitt

4/30/2015

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.

View this solution by signing up for a free trial.

Members can start a 7-Day free trial and enjoy unlimited access to the platform.

See Pricing Options

Start Free Trial

GET A PERSONALIZED SOLUTION

Ask your own question & get feedback from real experts

Find out why thousands trust the EE community with their toughest problems.

Tony Pitt

4/30/2015

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

ExpExchHelp

4/30/2015

ASKER

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

Saqib Husain

4/30/2015

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

This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.

rwheeler23

Tony Pitt

4/30/2015

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