One for JMB, DE-concatenating, but keeping relationship

[CompleteNewb]

I started a new post because the one JMB replied to worked, but now there's
a twist, and that post was long enough ago that I figured some newsreaders
wouldn't show this as new. Sorry if that is a bad way to approach this.

So, initially (problem solved) I was trying to re-populate some rows that
turned comma-separated lists in Column B into separate values, one per row,
while repeating (and possibly separating comma-separated lists) value(s) in
Column A associated with the original list in B. Thus, this:

Column A Column B
Dodge,Plymouth Trucks,Cars,Scooters
Buick Cars
GM,Ford Trucks,Cars

was turned into this:

Column A Column B
Dodge Trucks
Dodge Cars
Dodge Scooters
Plymouth Trucks
Plymouth Cars
Plymouth Scooters
Buick Cars
GM Trucks
GM Cars
Ford Trucks
Ford Cars

JMB's VBA (copied below) worked PERFECTLY. However, now there's a twist
(simpler in one way, but more complicated in another). After performing the
above, I now have added a third column (Column C) which has yet another
comma-separated list related to Column A and Column B. So now I have this
in Sheet1:

Column A Column B Column C
Dodge Trucks Recall,Discontinued
Dodge Cars Recall
Dodge Scooters Discontinued,New
*Ford Recall, New

*I occasionally have blanks in Column B or Column C, which the initial VBA
didn't take into account, but I figured out how to handle it, but now I
can't figure out how to handle it with the new situation.

And I basically need to do the same thing, except maintaining the
relationship in TWO columns, not just one. So in Sheet2 I need:

Column A Column B Column C
Dodge Trucks Recall
Dodge Trucks Discontinued
Dodge Cars Recall
Dodge Scooters Discontinued
Dodge Scooters New
Ford Recall
Ford New

I tried several different permutations of what seemed to me to be intuitive
modifications to JMB's code (ie. changing the range references, adding a 3rd
var (var3 as Variant) and a 3rd lngCount (lngCount3 as Long), and
extrapolating out through the rest of the code, taking the new variables
into account, adding the appropriate lines to the "For Each" blocks and the
"trim" functions, but the logic in my head is just not matching what the VBA
wants or does. Maybe it's because I don't have comma-separated lists in
Column A or Column B anymore? It's very frustrating to me, because I like
to think that I can usually analyze some code and modify it to accomplish
new tasks, but it's just not working for me lately. I don't know if that
means the code is getting more complicated or I'm losing brain cells.

JMB's initial VBA (which, again, worked absolutely perfectly) accomplished
what I was trying to do with 2 columns, with the possible comma-separated
lists in Column A and/or Column B. But now I need to do the same thing with
a THIRD column, repeating the related values in Column A and Column B (which
are now single values per cell, only Column C has the comma-separated list)
for every value separated by commas in Column C (but also handling blanks in
Column B or Column C). JMB's code for the 2 columns was:

Sub test()
Dim rngData As Range
Dim rngRow As Range
Dim rngDest As Range
Dim var1 As Variant
Dim var2 As Variant
Dim lngCount1 As Long
Dim lngCount2 As Long
Dim TotalCount As Long


Set rngData = Worksheets("Sheet1").Range("A1:B3") '<<CHANGE
Set rngDest = Worksheets("Sheet2").Range("A1") '<<CHANGE

For Each rngRow In rngData.Rows
var1 = Split(rngRow.Cells(1).Value, _
",", -1, vbTextCompare)
var2 = Split(rngRow.Cells(2).Value, _
",", -1, vbTextCompare)
For lngCount1 = LBound(var1) To UBound(var1)
For lngCount2 = LBound(var2) To UBound(var2)
rngDest.Offset(TotalCount, 0).Value = _
Trim(var1(lngCount1))
rngDest.Offset(TotalCount, 1).Value = _
Trim(var2(lngCount2))
TotalCount = TotalCount + 1
Next lngCount2
Next lngCount1
Next rngRow


End Sub

If anyone can help me with this, I'd appreciate it. And if you happen to
know why my code modifications don't work anymore, feel free to suggest some
type of brain food or a place that covers how to add (what I assume to be)
minor complications to an existing solution. I mean, seriously, what's
going on with me? And why are my posts so long?

As an aside, if this would be easier to do in Access, any suggestions there
are welcome also. I've always thought myself to be better with Access than
with Excel, and yet I couldn't wrap my brain around this using the query
builder either. It seems like every time I DON'T want Field1 (the Access
equivalent of Excel's Column A) to repeat values, it happens, and then when
I want to do a Make Table query that DOES repeat Field1 for every related
value in Field2, then I can't make it work. I mean, sheesh.

Thanks for reading, and thanks to those (like JMB and Mr. Ogilvy and all of
you out there) who have already helped me (and those like me) save hours and
hours of repetetive tasks and failed experimentation.

The Complete Newb

 

[Bob Phillips]

Option Explicit

Sub test()
Dim rngData As Range
Dim rngRow As Range
Dim rngDest As Range
Dim var1 As Variant, var2 As Variant, var3 As Variant
Dim iStart2 As Long, iEnd2 As Long
Dim iStart3 As Long, iEnd3 As Long
Dim Count1 As Long, Count2 As Long, count3 As Long
Dim cTotal As Long


With Worksheets("Sheet1")
Set rngData = .Range(.Range("A1"),
..Range("A1").End(xlDown)).Resize(, 3)
End With
Set rngDest = Worksheets("Sheet2").Range("A1") '<<CHANGE

For Each rngRow In rngData.Rows
var1 = Split(rngRow.Cells(1).Value, _
",", -1, vbTextCompare)
var2 = Split(rngRow.Cells(2).Value, _
",", -1, vbTextCompare)
var3 = Split(rngRow.Cells(3).Value, _
",", -1, vbTextCompare)
For Count1 = LBound(var1) To UBound(var1)
If UBound(var2) = -1 Then
iStart2 = 1: iEnd2 = 1
Else
iStart2 = LBound(var2): iEnd2 = UBound(var2)
End If
For Count2 = iStart2 To iEnd2
If UBound(var3) = -1 Then
iStart3 = 1: iEnd2 = 1
Else
iStart3 = LBound(var3): iEnd3 = UBound(var3)
End If
For count3 = LBound(var3) To UBound(var3)
rngDest.Offset(cTotal, 0).Value = _
Trim(var1(Count1))
If UBound(var2) = -1 Then
rngDest.Offset(cTotal, 1).Value = ""
Else
rngDest.Offset(cTotal, 1).Value = _
Trim(var2(Count2))
End If
If UBound(var3) = -1 Then
rngDest.Offset(cTotal, 2).Value = ""
Else
rngDest.Offset(cTotal, 2).Value = _
Trim(var3(count3))
End If
cTotal = cTotal + 1
Next count3
Next Count2
Next Count1
Next rngRow

End Sub




--
HTH

Bob Phillips

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[kounoike]

Assuming data in ColumnA, B and C in Sheet1

Sub splittest()
Dim i As Long, j As Long, k As Long, l As Long
Dim p As Long, pp As Long, u As Long, z As Long
Dim aa()
Dim src As Worksheet, dst As Worksheet

Set src = worksheets("Sheet1") 'Change
Set dst = worksheets("Sheet2") 'Change
u = 1
With src
For p = 0 To .Cells(Cells.Rows.Count, 1).End(xlUp).Row
z = 1
ReDim aa(2)
For pp = 0 To 2
aa(pp) = Split(.Cells(1 + p, 1 + pp), ",")
For i = 0 To UBound(aa(pp))
aa(pp)(i) = Trim(aa(pp)(i))
Next
If UBound(aa(pp)) < 0 Then
aa(pp) = Array("")
End If
z = z * (UBound(aa(pp)) + 1)
Next
z = z - 1
If z < 0 Then
z = 1
End If
ReDim x(z, 2)
For i = 0 To UBound(aa(0))
For j = 0 To UBound(aa(1))
For k = 0 To UBound(aa(2))
x(l, 0) = aa(0)(i)
x(l, 1) = aa(1)(j)
x(l, 2) = aa(2)(k)
l = l + 1
Next
Next
Next
dst.Range("A" & u & ":C" & u + z) = x
u = u + z + 1
l = 0
Next
End With
End Sub

keizi

 

[CompleteNewb]

kounoike:

Worked like a dream, and a hearty thanks to you. Mr. Phillips, yours seemed
to work also, and I grealy appreciate your help. For some reason your
approach skipped over 3 consecutive values out of 700, and I'm fiddling
around trying to investigate the cause. I thought maybe it was because of
apostrophes in the values in Column A, but it handled other values with
apostrophes fine.

Both of you have provided invaluable code that I can use to compare to the
previous code I had for handling only 2 columns, so maybe now I can figure
out what was wrong with my brain and use this progression from code for 2 to
code for 3 to be able to handle further complications going forward. I
can't say I won't be looking for help again, of course, but in terms of this
particular problem, you have taught a man to fish.

Thanks again.

 

[kounoike]

Could you show me the data which failed to extract? then i'll try to check
it out.

keizi

 

[CompleteNewb]

keizi:

It was the other code that passed over 3 values, not yours. However, if
you're interested, the values it skipped had blanks in Column C, that was
the cause. Other than that, it worked perfectly. I should be able to look
it over and compare to others, but if you can find it sooner and have the
time, I'd appreciate your feedback.

Thanks again for your awesome code!

 

[Bob Phillips]

Couple of missing updates

Sub test()
Dim rngData As Range
Dim rngRow As Range
Dim rngDest As Range
Dim var1 As Variant, var2 As Variant, var3 As Variant
Dim iStart2 As Long, iEnd2 As Long
Dim iStart3 As Long, iEnd3 As Long
Dim Count1 As Long, Count2 As Long, count3 As Long
Dim cTotal As Long


With Worksheets("Sheet1")
Set rngData = .Range(.Range("A1"),
..Range("A1").End(xlDown)).Resize(, 3)
End With
Set rngDest = Worksheets("Sheet2").Range("A1") '<<CHANGE

For Each rngRow In rngData.Rows
var1 = Split(rngRow.Cells(1).Value, _
",", -1, vbTextCompare)
var2 = Split(rngRow.Cells(2).Value, _
",", -1, vbTextCompare)
var3 = Split(rngRow.Cells(3).Value, _
",", -1, vbTextCompare)
For Count1 = LBound(var1) To UBound(var1)
If UBound(var2) = -1 Then
iStart2 = 1: iEnd2 = 1
Else
iStart2 = LBound(var2): iEnd2 = UBound(var2)
End If
For Count2 = iStart2 To iEnd2
If UBound(var3) = -1 Then
iStart3 = 1: iEnd3 = 1
Else
iStart3 = LBound(var3): iEnd3 = UBound(var3)
End If
For count3 = iStart3 To iEnd3
rngDest.Offset(cTotal, 0).Value = _
Trim(var1(Count1))
If UBound(var2) = -1 Then
rngDest.Offset(cTotal, 1).Value = ""
Else
rngDest.Offset(cTotal, 1).Value = _
Trim(var2(Count2))
End If
If UBound(var3) = -1 Then
rngDest.Offset(cTotal, 2).Value = ""
Else
rngDest.Offset(cTotal, 2).Value = _
Trim(var3(count3))
End If
cTotal = cTotal + 1
Next count3
Next Count2
Next Count1
Next rngRow

End Sub

--
HTH

Bob Phillips

(there's no email, no snail mail, but somewhere should be gmail in my addy)