VBA Text to Rows with Multiple Columns as Delimiter

B

balla506

New Member
Joined
Sep 10, 2012
Messages
32
Hi,

I have no idea how to approach this but basically I have columns that have IDs, Customer Name, Tax Number separated by semicolons. I need to split these into multiple rows but the tough part is that basically I need to take the first ID and take the first customer name and first tax ID and put it in a row(638,BoB,10-232322). Then the second record on a new row (04,Law,555-555-5555). Some cells contain a different number of records. It is not always 3 per row. Any help would be appreciated. Thanks.[TABLE="width: 581"]
<colgroup><col><col span="2"></colgroup><tbody>[TR]
[TD]Actimize Party ID
(CRS dependent data set) [/TD]
[TD]Customer or Subject Name[/TD]
[TD]Customer Taxpayer ID Number[/TD]
[/TR]
[TR]
[TD]638;04;95 [/TD]
[TD]BoB; Law; Dia[/TD]
[TD]10-252522; 555-555-5555; 777-777-7777[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
This VBA code splits data of the active sheet to the rows of the "Result" sheet
Rich (BB code): 
Sub SplitByRows()
 
  Const DELIM = ";" ' <-- Words delimiter, change to suit
 
  Dim a(), b(), v1, v2, v3
  Dim c As Long, i As Long, j As Long, r As Long
 
  ' Copy source data to array a()
  a() = ActiveSheet.UsedRange.Resize(, 3).Value
 
  ' Prepare output array
  ReDim b(1 To Rows.Count, 1 To 3)
 
  'Main
  For r = 1 To UBound(a)
    If Len(Trim(a(r, 1))) Then
      v1 = Split(a(r, 1), DELIM)
      v2 = Split(a(r, 2), DELIM)
      v3 = Split(a(r, 3), DELIM)
      If UBound(v1) <> UBound(v2) Or UBound(v1) <> UBound(v3) Then
        Rows(r).Select
        MsgBox "Inconsistent data!", vbCritical, "Exit"
        Exit Sub
      End If
      For i = 0 To UBound(v1)
        j = j + 1
        b(j, 1) = Trim(v1(i))
        b(j, 2) = Trim(v2(i))
        b(j, 3) = Trim(v3(i))
      Next
    End If
  Next
 
  ' Create Result sheet if it's not present
  On Error Resume Next
  With Sheets("Result"): End With
  If Err Then
    With Sheets.Add(Before:=Sheets(1))
      .Name = "Result"
    End With
  End If
  On Error GoTo 0
 
  ' Put output data into Result sheet
  With Sheets("Result")
    .UsedRange.ClearContents
    If j Then .Range("A1").Resize(j, UBound(b, 2)).Value = b()
  End With
 
End Sub

How to implement:
1. Select and copy the above code (Ctrl-C)
2. In workbook press Alt-F11 to go to VBE
3. Menu: Insert - Module
4. Paste the code (Ctrl-V)
5. Press Alt-Q to close VBE
6. Activate sheet with source data
7. Press Alt-F8 and run the macro SplitByRows

Source data:
Book1
ABC
1Actimize Party IDCustomer or Subject NameCustomer Taxpayer ID Number
2638;04;95BoB; Law; Dia10-252522; 555-555-5555; 777-777-7777
3111;22;33Aaa; Bbb; Ccc111-111-111; 22-22-22; 33-33-33
Sheet1


The resulting data:
Book1
ABC
1Actimize Party IDCustomer or Subject NameCustomer Taxpayer ID Number
2638BoB10-252522
34Law555-555-5555
495Dia777-777-7777
5111Aaa111-111-111
622Bbb22-22-22
733Ccc33-33-33
Result
 
Last edited:
Upvote 0
Here is another macro that you can consider...
Code: 
[table="width: 500"]
[tr]
	[td]Sub SplitByRows()
  Dim Col As Long, LastRow As Long, ColParts() As String
  LastRow = Cells(Rows.count, "A").End(xlUp).Row
  For Col = 1 To 3 'Column A to Column C
    ColParts = Split(Join(Application.Transpose(Range(Cells(2, Col), Cells(LastRow, Col))), ";"), ";")
    With Cells(2, Col).Resize(UBound(ColParts) + 1)
      .NumberFormat = "@"
      .Value = Application.Transpose(ColParts)
    End With
  Next
End Sub
[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
Rick Rothstein said:
Here is another macro that you can consider...
Click to expand...
Hi Rick,

Just want to warn about limit of 65536 rows in result for Transpose method,
in this case it means approx 22000 of source rows with 3 items for each cell.
Not sure it's critical or not for OP.

Regards,
Vlad
 
Last edited:
Upvote 0
ZVI said:
Hi Rick,

Just want to warn about limit of 65536 rows in result for Transpose method,
in this case it means approx 22000 of source rows with 3 items for each cell.
Not sure it's critical or not for OP.
Click to expand...
Good point... thanks for mentioning it (I had planned to mention it myself, but then I forgot:oops:).

Just so the OP understands, my code can output only a total of 65535 rows before it will stop working with an error.
 
Upvote 0
Thanks so much for your help ZVI and Rick. Both your examples will work for me. I can follow Rick's but the arrays throw me for a loop. I do not understand how they function. After looking at the code I thought it would only work for rows with 3 or less semicolons but it worked for more than that (which is awesome). The only other caveat I failed to mention was that there are other columns mixed in with the ones that need to be split out (like below). Basically I just need to say if it only has one value (no semicolons) add it to the other rows it creates in the split out. I hope this is pretty easy to do.


[TABLE="class: cms_table, width: 581"]
<tbody>[TR]
[TD]Party ID
[/TD]
[TD]Date[/TD]
[TD]Customer Taxpayer ID Number[/TD]
[/TR]
[TR]
[TD]638;04;95[/TD]
[TD]4/15/2016[/TD]
[TD]10-252522; 555-555-5555; 777-777-7777[/TD]
[/TR]
</tbody>[/TABLE]

4/15/201610-252522

[TABLE="width: 1"]
<tbody>[TR]
[TD]4/15/2016

<tbody>
[TD="align: center"]1[/TD]
[TD="bgcolor: #CCFFFF"]Party ID[/TD]
[TD="bgcolor: #CCFFFF"]Date[/TD]
[TD="bgcolor: #CCFFFF"]Customer Taxpayer ID Number[/TD]

[TD="align: center"]2[/TD]
[TD="align: right"]638[/TD]

[TD="align: center"]3[/TD]
[TD="align: right"]4
[/TD]

</tbody>
[/TD]
[TD]777-777-7777[/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: right"]111[/TD]
[TD]Aaa[/TD]
[TD]111-111-111[/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: right"]22[/TD]
[TD]Bbb[/TD]
[TD]22-22-22[/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD="align: right"]33[/TD]
[TD]Ccc[/TD]
[TD]33-33-33[/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Upvote 0
You can’t do that with Transpose method.
Try the below modification of my code instead:
Rich (BB code): 
Sub SplitByRows2()
 
  Const DELIM = ";" ' <-- Words delimiter, change to suit
 
  Dim a(), b(), v1, v2, v3
  Dim i As Long, j As Long, k As Long, r As Long
 
  ' Copy source data to array a()
  a() = ActiveSheet.UsedRange.Resize(, 3).Value
 
  ' Prepare output array
  ReDim b(1 To Rows.Count, 1 To 3)
 
  'Main
  On Error GoTo exit_
  For r = 1 To UBound(a)
    If Len(Trim(a(r, 1))) Then
      v1 = Split(a(r, 1), DELIM)
      v2 = Split(a(r, 2), DELIM)
      v3 = Split(a(r, 3), DELIM)
      k = UBound(v1)
      If UBound(v2) > k Then k = UBound(v2)
      If UBound(v3) > k Then k = UBound(v3)
      For i = 0 To k
        j = j + 1
        If UBound(v1) = 0 Then b(j, 1) = Trim(v1(0)) Else b(j, 1) = Trim(v1(i))
        If UBound(v2) = 0 Then b(j, 2) = Trim(v2(0)) Else b(j, 2) = Trim(v2(i))
        If UBound(v3) = 0 Then b(j, 3) = Trim(v3(0)) Else b(j, 3) = Trim(v3(i))
      Next
    End If
  Next
 
  ' Create Result sheet if it's not present
  On Error Resume Next
  With Sheets("Result"): End With
  If Err Then
    With Sheets.Add(Before:=Sheets(1))
      .Name = "Result"
    End With
  End If
  On Error GoTo exit_
 
  ' Put output data into Result sheet
  With Sheets("Result")
    .UsedRange.ClearContents
    If j Then .Range("A1").Resize(j, UBound(b, 2)).Value = b()
  End With
 
exit_:
 
  If Err Then
    Rows(r).Select
    MsgBox "Error in row #" & r & vbLf & Err.Description, vbCritical, "Exit"
    Err.Clear
  End If
 
End Sub

Source data:
Book1
ABC
1Actimize Party IDCustomer or Subject NameCustomer Taxpayer ID Number
2638;04;95BoB; Law; Dia10-252522; 555-555-5555; 777-777-7777
3111;22;33Now111-111-111; 22-22-22; 33-33-33
444;55;66Aaa; Bbb; Ccc444-444-444; 55-55-55; 66-66-66
Sheet1


Result:
Book1
ABC
1Actimize Party IDCustomer or Subject NameCustomer Taxpayer ID Number
2638BoB10-252522
34Law555-555-5555
495Dia777-777-7777
5111Now111-111-111
622Now22-22-22
733Now33-33-33
844Aaa444-444-444
955Bbb55-55-55
1066Ccc66-66-66
Sheet1
 
Last edited:
Upvote 0
Vladimir you are the best. Thanks for the rework. This works beautifully and I figured out how to transform it for my needs. Thanks again.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
VBA: Checking if a row exists with exact data in multiple columns
Replies
6
Views
660
mwl_y
M
B
  • Question Question
VBA code to cut and paste multiple filtered rows based on multiple criteria
Replies
2
Views
1K
Alex Blakenburg
A
I
  • Question Question
Create an Excel VBA Form text box to view multiple records, one at a time
Replies
0
Views
694
Ian_Hov
I
C
  • Solved
VBA for sorting all data in active sheet(varies in column and row length)
Replies
6
Views
871
johnnyL
J
D
  • Question Question
VBA - Split Source file-Find oldest date in column. Copy all rows with date to new sheet, Repeat on next oldest date. Also, remove some unwanted data.
Replies
0
Views
1K
DK643
D

Forum statistics

Threads
1,223,238
Messages
6,170,939
Members
452,368
Latest member
jayp2104

Share this page

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