Text to Columns to Rows Macro

Gimics

Board Regular
Joined
Jan 29, 2014
Messages
164
Office Version
  1. 365
Platform
  1. Windows
Hello,

I am looking for some help or to repurpose a simple macro to do two things. I have a table of data that consists of a few columns of consistent data (ex. vendor names and vendor numbers) and then one column with cells full of comma delimited invoice numbers.

What I would like to do is convert the comma delimited cells into columns (easy enough, with the Text to Columns function), but then I would like to reformat the result into individual rows for each unique invoice, with the new rows maintaining the vendor name's and ID's that the existing line contains.

Example original:
[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Vendor Name[/TD]
[TD]Vendor Number[/TD]
[TD]Invoices[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]XYZ Company[/TD]
[TD]12345[/TD]
[TD]5000-1, 5000-2, 5000-3[/TD]
[/TR]
</tbody>[/TABLE]


Example after text to columns:
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]D[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Vendor Name[/TD]
[TD]Vendor Number[/TD]
[TD]Invoices[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]XYZ Company[/TD]
[TD]12345[/TD]
[TD]5000-1[/TD]
[TD]5000-2[/TD]
[TD]5000-3[/TD]
[/TR]
</tbody>[/TABLE]


Example result:
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Vendor Name[/TD]
[TD]Vendor Number[/TD]
[TD]Invoice[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]XYZ Company[/TD]
[TD]12345[/TD]
[TD]5000-1[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]XYZ Company[/TD]
[TD]12345[/TD]
[TD]5000-2[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]XYZ Company[/TD]
[TD]12345[/TD]
[TD]5000-3[/TD]
[/TR]
</tbody>[/TABLE]


I have one vendor that has up to 69 invoices contained in one cell and using text to columns over the existing data results in 29,000 unique invoice records, from approximately 8,000 rows of vendors.

Hoping someone might be able to help out with a simple macro for creating and populating all of the unique records for each vendor.

Thanks in advance!
 
Last edited:
Thanks both - Rick, if I could turn back time, I would. Hopefully the apology in my previous post didn't go unnoticed...

I updated Rick's macro to be more dynamic with the addition of one more variable and a for statement

Code:
Sub VendorInvoices()  Dim R As Long, X As Long, Z As Long, LastRow As Long, InvoiceCount As Long, Constants As Long
  Dim Data As Variant, Result As Variant, Invoices() As String
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Data = Range("A2:Q" & LastRow)
  Constants = 16
  InvoiceCount = Evaluate(Replace("SUM(1+LEN(Q2:Q#)-LEN(SUBSTITUTE(Q2:Q#,"","","""")))", "#", LastRow))
  ReDim Result(1 To InvoiceCount, 1 To Constants + 1)
  For R = 1 To UBound(Data)
    Invoices = Split(Data(R, Constants + 1), ",")
    For Z = 0 To UBound(Invoices)
      X = X + 1
      For Y = 1 To Constants
        Result(X, Y) = Data(R, Y)
      Next Y
      Result(X, Constants + 1) = Trim(Invoices(Z))
    Next
  Next
  With Range("S1").Resize(, Constants + 1)
    .Resize(X) = Result
    .EntireColumn.AutoFit
  End With
End Sub

It could be improved a bit more by removing the fixed column references (A, Q, S, etc.) and using a dynamic column count, but the above did the trick.

The output is the correct length, but I'll have to do some spot checks to make sure everything is captured.

Thanks again for the help!
 
Upvote 0

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Thanks both - Rick, if I could turn back time, I would. Hopefully the apology in my previous post didn't go unnoticed...

I updated Rick's macro to be more dynamic with the addition of one more variable and a for statement

Code:
Sub VendorInvoices()  Dim R As Long, X As Long, Z As Long, LastRow As Long, InvoiceCount As Long, Constants As Long
  Dim Data As Variant, Result As Variant, Invoices() As String
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Data = Range("A2:Q" & LastRow)
  Constants = 16
  InvoiceCount = Evaluate(Replace("SUM(1+LEN(Q2:Q#)-LEN(SUBSTITUTE(Q2:Q#,"","","""")))", "#", LastRow))
  ReDim Result(1 To InvoiceCount, 1 To Constants + 1)
  For R = 1 To UBound(Data)
    Invoices = Split(Data(R, Constants + 1), ",")
    For Z = 0 To UBound(Invoices)
      X = X + 1
      For Y = 1 To Constants
        Result(X, Y) = Data(R, Y)
      Next Y
      Result(X, Constants + 1) = Trim(Invoices(Z))
    Next
  Next
  With Range("S1").Resize(, Constants + 1)
    .Resize(X) = Result
    .EntireColumn.AutoFit
  End With
End Sub

It could be improved a bit more by removing the fixed column references (A, Q, S, etc.) and using a dynamic column count, but the above did the trick.

The output is the correct length, but I'll have to do some spot checks to make sure everything is captured.
I tried to run your code for data that I made up and it does not work for me (I get an error on the first line of code after the With statement... X has the value of 0). I am guessing I did not set up the sample data correctly. I did this because I wanted to see figure out you have and what you are trying to accomplish with it. For me, a picture really is worth far more than a thousand words. What I need to see rather than your code is your existing layout and the result layout you want from it... then I would know what you have and what you want from it.
 
Last edited:
Upvote 0
No worries Rick - it worked for me.

I kept the Invoices column as the last column in the "Data" range (column 17 in actuality, or "Constants +1"), and the updated code reflects. Everything else from the prior example is similar:

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[TD]L[/TD]
[TD]M[/TD]
[TD]N[/TD]
[TD]O[/TD]
[TD]P[/TD]
[TD]Q[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Vendor Name[/TD]
[TD]Vendor Number[/TD]
[TD]Constant 3[/TD]
[TD]Constant 4[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD]Constant 16[/TD]
[TD]Invoices[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]XYZ Company[/TD]
[TD]12345[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD].[/TD]
[TD]5000-1, 5000-2, 5000-3 [/TD]
[/TR]
</tbody>[/TABLE]

The output is exactly what I was looking for.

Thanks again for the help,
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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