Parsing and combining delimited text

demeeder

New Member
Joined
Apr 27, 2015
Messages
45
I think this is a text to columns and then something else. The final result of what I am trying to accomplish is represented below. Letters in LOC1 and LOC2 are not important... random and represent a location. First in cell LOC1 is associated with the first in LOC2... and so on....
IDLOC1LOC2
1a,b,c,dd,e,f,a
2d,t,f,ra,b,c,d
3a,c,f,vr,t,e,r
4r,t,y,wd,c,b,a
1ad
1be
1cf
1da
2da
2tb
2fc
2rd

<tbody>
</tbody>

Thanks!

Dave
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Are there always exactly 4 comma delimited letters in each cell as your example shows?
 
Last edited:
Upvote 0
Give this macro a try...
Code:
[table="width: 500"]
[tr]
	[td]Sub LOC1_LOC2()
  Dim R As Long, C As Long, LastRow As Long, Txt As String, Combined() As String
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Application.ScreenUpdating = False
  For R = 2 To LastRow
    Txt = Application.Rept(Cells(R, "A").Value & ",", 1 + Len(Cells(R, "B").Value) - Len(Replace(Cells(R, "B").Value, ",", "")))
    Cells(R, "A").Value = Left(Txt, Len(Txt) - 1)
  Next
  For C = 1 To 3
    Combined = Split(Join(Application.Transpose(Range(Cells(2, C), Cells(LastRow, C))), ","), ",")
    Cells(2, C).Resize(UBound(Combined) + 1) = Application.Transpose(Combined)
  Next
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]
 
Upvote 0
Another approach to consider. Test in a copy of your workbook as this over-writes the original data.
Code:
Sub Rearrange()
  Dim a As Variant, b As Variant, bits As Variant
  Dim i As Long, j As Long, n As Long, r As Long
  
  a = Range("A2", Range("C" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To Rows.Count, 1 To 3)
  For i = 1 To UBound(a)
    bits = Split(a(i, 2) & "," & a(i, 3), ",")
    n = (UBound(bits) + 1) / 2
    For j = 0 To n - 1
      r = r + 1
      b(r, 1) = a(i, 1): b(r, 2) = bits(j): b(r, 3) = bits(j + n)
    Next j
  Next i
  Range("A2:C2").Resize(r).Value = b
End Sub
 
Upvote 0
Thanks, Rick. This seems to work perfectly. I was able to replace the letters with actual location data and the macro performed as needed.
 
Upvote 0
Another approach to consider. Test in a copy of your workbook as this over-writes the original data.
Code:
Sub Rearrange()
  Dim a As Variant, b As Variant, bits As Variant
  Dim i As Long, j As Long, n As Long, r As Long
  
  a = Range("A2", Range("C" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To Rows.Count, 1 To 3)
  For i = 1 To UBound(a)
    bits = Split(a(i, 2) & "," & a(i, 3), ",")
    n = (UBound(bits) + 1) / 2
    For j = 0 To n - 1
      r = r + 1
      b(r, 1) = a(i, 1): b(r, 2) = bits(j): b(r, 3) = bits(j + n)
    Next j
  Next i
  Range("A2:C2").Resize(r).Value = b
End Sub


Thanks, Peter. This also worked, however I can't have any cells be overwritten, as you warned.
 
Upvote 0
Thanks, Peter. This also worked, however I can't have any cells be overwritten, as you warned.
So, like Rick's (which also over-wrote the original data), it would just be a matter of altering either the red text to point to where the original data is or the blue text to point to where the results are required, or both. :)

Rich (BB code):
Sub Rearrange()
  Dim a As Variant, b As Variant, bits As Variant
  Dim i As Long, j As Long, n As Long, r As Long
  
  a = Range("A2", Range("C" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To Rows.Count, 1 To 3)
  For i = 1 To UBound(a)
    bits = Split(a(i, 2) & "," & a(i, 3), ",")
    n = (UBound(bits) + 1) / 2
    For j = 0 To n - 1
      r = r + 1
      b(r, 1) = a(i, 1): b(r, 2) = bits(j): b(r, 3) = bits(j + n)
    Next j
  Next i
  Range("A2:C2").Resize(r).Value = b
End Sub
 
Last edited:
Upvote 0
So, like Rick's (which also over-wrote the original data), it would just be a matter of altering either the red text to point to where the original data is or the blue text to point to where the results are required, or both. :)

Understood (I think) and thank you. I should have been more clear. What I was meaning to avoid was overwriting the cells below when there was no location data included. See below for example. ID2 and ID3 appear too be removed.

Bottom line, in the data set I am trying to clean up, there may not always be data in LOC1 and LOC2 and when I break out the nested data I don't want to lose any rows. I hope that was more clear.

IDLOC1LOC2
1USA, CAN, FRAFRA,CAN,USA
2
3
4
5
1USAFRA
1CANCAN
1FRAUSA
4
5

<tbody>
</tbody>

When I ran Rick's, the same data resulted in what I think will preserve rows that do not have LOC data

IDLOC1LOC2
1USAFRA
1CANCAN
1FRAUSA
2
3
4
5

<tbody>
</tbody>

I am obviously not terribly smart on Macros, so both of your help has been very appreciated!

Curious... is it much more complicated if I said that there are other columns with data that I wanted to preserve with the associated rows? I noticed when I added more columns, that data did not move with the newly formed rows... I wouldn't over think it as I believe I can just pull those three columns from the original data to accomplish my intent.

Dave
 
Last edited:
Upvote 0
.. in the data set I am trying to clean up, there may not always be data in LOC1 and LOC2 and when I break out the nested data I don't want to lose any rows.
OK, that was not included in the original description or sample data. ;)

Easy enough to account for that, but before doing so we must also deal with the following.
... is it much more complicated if I said that there are other columns with data that I wanted to preserve with the associated rows?
Tell us more about what you actually have and where. For example ..
- About how many rows of data will there be before the code is run?
- What would be the most (approximately will do) number of items in a cell in LOC1 or LOC2?
- How many columns are there in your actual data?
- Are those columns all required to be preserved with the associated rows? If not, which ones are required to be preserved?
- Which columns are ID, LOC1 and LOC2?
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,552
Messages
6,114,278
Members
448,560
Latest member
Torchwood72

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top