Link to home
Start Free TrialLog in
Avatar of ExpExchHelp
ExpExchHelpFlag for United States of America

asked on

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
ASKER CERTIFIED SOLUTION
Avatar of Tony Pitt
Tony Pitt

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Tony Pitt
Tony Pitt

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
Avatar of ExpExchHelp

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
Avatar of Saqib Husain
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

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