Text to Columns to Rows Macro

[Gimics]

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:

	A	B	C
1	Vendor Name	Vendor Number	Invoices
2	XYZ Company	12345	5000-1, 5000-2, 5000-3

<tbody>
</tbody>

Example after text to columns:

	A	B	C	D	D
1	Vendor Name	Vendor Number	Invoices
2	XYZ Company	12345	5000-1	5000-2	5000-3

<tbody>
</tbody>

Example result:

	A	B	C
1	Vendor Name	Vendor Number	Invoice
2	XYZ Company	12345	5000-1
3	XYZ Company	12345	5000-2
4	XYZ Company	12345	5000-3

<tbody>
</tbody>

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!

 

[Rick Rothstein]

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub VendorInvoices()
  Dim R As Long, X As Long, Z As Long, LastRow As Long, InvoiceCount As Long
  Dim Data As Variant, Result As Variant, Invoices() As String
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Data = Range("A2:C" & LastRow)
  InvoiceCount = Evaluate(Replace("SUM(1+LEN(C2:C#)-LEN(SUBSTITUTE(C2:C#,"","","""")))", "#", LastRow))
  ReDim Result(1 To InvoiceCount, 1 To 3)
  For R = 1 To UBound(Data)
    Invoices = Split(Data(R, 3), ",")
    For Z = 0 To UBound(Invoices)
      X = X + 1
      Result(X, 1) = Data(R, 1)
      Result(X, 2) = Data(R, 2)
      Result(X, 3) = Invoices(Z)
    Next
  Next
  With Range("F1").Resize(, 3)
    .Value = Array("Vendor Name", "Vendor Number", "Invoice")
    .Resize(X) = Result
    .EntireColumn.AutoFit
  End With
End Sub[/td]
[/tr]
[/table]

 

[hiker95]

Gimics,

Try the following macro:

Sub ReorganizeData()
' hiker95, 11/17/2017, ME1031992
Application.ScreenUpdating = False
Dim r As Long, lr As Long, s
With ActiveSheet
  lr = .Cells(.Rows.Count, 1).End(xlUp).Row
  For r = lr To 2 Step -1
    s = Split(.Cells(r, 3), ", ")
    .Rows(r + 1).Resize(UBound(s)).Insert
    .Cells(r, 1).Resize(UBound(s) + 1) = .Cells(r, 1).Value
    .Cells(r, 2).Resize(UBound(s) + 1) = .Cells(r, 2).Value
    .Cells(r, 3).Resize(UBound(s) + 1) = Application.Transpose(s)
  Next r
  .Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub

 

[Rick Rothstein]

Gimics,

Try the following macro:

Sub ReorganizeData()
' hiker95, 11/17/2017, ME1031992
Application.ScreenUpdating = False
Dim r As Long, lr As Long, s
With ActiveSheet
  lr = .Cells(.Rows.Count, 1).End(xlUp).Row
  For r = lr To 2 Step -1
    s = Split(.Cells(r, 3), ", ")
    .Rows(r + 1).Resize(UBound(s)).Insert
    .Cells(r, 1).Resize(UBound(s) + 1) = .Cells(r, 1).Value
    .Cells(r, 2).Resize(UBound(s) + 1) = .Cells(r, 2).Value
    .Cells(r, 3).Resize(UBound(s) + 1) = Application.Transpose(s)
  Next r
  .Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub

Two points about your code...

1) Your code will error out if there is only one invoice number in a cell in Column C.

2) Your code will be somewhat slow compared to the code I posted in Message #2 , mainly because I do all processing in memory and you write individually to some 24,000 cells (the OP said he had 8000 rows of data) and that is assuming your Transposed array writing to multiple cells is considered a single write to a cell. I did a quick patch to avoid the error in your code (but it outputs incorrectly for cells with only one invoice number) just to be able to measure its speed. On my computer, your code takes about 7.5 seconds whereas the code I posted takes 0.12 seconds).

 

[Rick Rothstein]

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub VendorInvoices()
  Dim R As Long, X As Long, Z As Long, LastRow As Long, InvoiceCount As Long
  Dim Data As Variant, Result As Variant, Invoices() As String
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Data = Range("A2:C" & LastRow)
  InvoiceCount = Evaluate(Replace("SUM(1+LEN(C2:C#)-LEN(SUBSTITUTE(C2:C#,"","","""")))", "#", LastRow))
  ReDim Result(1 To InvoiceCount, 1 To 3)
  For R = 1 To UBound(Data)
    Invoices = Split(Data(R, 3), ",")
    For Z = 0 To UBound(Invoices)
      X = X + 1
      Result(X, 1) = Data(R, 1)
      Result(X, 2) = Data(R, 2)
      Result(X, 3) = [B][B][COLOR="#FF0000"][SIZE=4]Trim([/SIZE][/COLOR][/B][/B]Invoices(Z)[B][COLOR="#FF0000"][SIZE=4])[/SIZE][/COLOR][/B]
    Next
  Next
  With Range("F1").Resize(, 3)
    .Value = Array("Vendor Name", "Vendor Number", "Invoice")
    .Resize(X) = Result
    .EntireColumn.AutoFit
  End With
End Sub[/td]
[/tr]
[/table]

I need to make one patch to the code above which is shown in red above. This allows the delimiter between invoice numbers to be either a comma or a comma followed by a space. It is not that the code does not work, it is just that it will output a leading space when a comma/space was used as the delimiter. The above addition fixes that problem.

 

[hiker95]

Gimics,

Try the following macro:

Sub ReorganizeData_V2()
' hiker95, 11/18/2017, ME1031992
Application.ScreenUpdating = False
Dim r As Long, lr As Long, s
With ActiveSheet
  lr = .Cells(.Rows.Count, 1).End(xlUp).Row
  For r = lr To 2 Step -1
    If InStr(.Cells(r, 3), ", ") Then
      s = Split(.Cells(r, 3), ", ")
      .Rows(r + 1).Resize(UBound(s)).Insert
      .Cells(r, 1).Resize(UBound(s) + 1) = .Cells(r, 1).Value
      .Cells(r, 2).Resize(UBound(s) + 1) = .Cells(r, 2).Value
      .Cells(r, 3).Resize(UBound(s) + 1) = Application.Transpose(s)
    ElseIf InStr(.Cells(r, 3), ",") Then
      s = Split(.Cells(r, 3), ",")
      .Rows(r + 1).Resize(UBound(s)).Insert
      .Cells(r, 1).Resize(UBound(s) + 1) = .Cells(r, 1).Value
      .Cells(r, 2).Resize(UBound(s) + 1) = .Cells(r, 2).Value
      .Cells(r, 3).Resize(UBound(s) + 1) = Application.Transpose(s)
    End If
  Next r
  .Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub

 

[Gimics]

Thanks for the input! These both appear to work based on the theoretical data I provided.

I have to apologize though; my actual workbook data contains many more columns of information than the data provided (17 total, to be exact, including the invoice numbers). How could I make the .transpose function more dynamic so that the entire row is transferred to each new invoice row, instead of grabbing each value from each column (and having 17 lines of code, one for each column)? This additional data would be handled just like the vendor name/number in my example (is repeatable for each new unique invoice number row).

Thanks again in advance!

 

[Rick Rothstein]

...instead of grabbing each value from each column (and having 17 lines of code, one for each column)?

But that is the layout you (appeared) to show you wanted in you "Example Result"... are you now saying you don't want that layout? If so, please show your sample data and then show us how you actually want it to look.


Please Note
-------------------
For future questions you may ask, please do not simplify your question for us... doing so will get you a great answer to a question you do not actually have and which you do not actually care about AND it will almost always lead to you coming back for help when the solution we give you for the simplified question cannot be applied to your actual data and its layout. One thing you must keep in mind when you ask a question in a forum... the people you are asking to help you know absolutely nothing about your data, absolutely nothing about how it is laid out in the workbook, absolutely nothing about what you want done with it and absolutely nothing about how whatever it is you want done is to be presented back to you as a result... you must be very specific about describing each of these areas, in detail, and you should not assume that we will be able to "figure it out" on our own. Remember, you are asking us for help... so help us to be able to help you by providing the information we need to do so, even if that information seems "obvious" to you (remember, it is only obvious to you because of your familiarity with your data, its layout and the overall objective for it).

 

[hiker95]

Thanks for the input!

Gimics,

Thanks for the feedback.

You are very welcome. Glad we could help.

And, come back anytime.

 

[hiker95]

Thanks for the input! These both appear to work based on the theoretical data I provided.

I have to apologize though; my actual workbook data contains many more columns of information than the data provided (17 total, to be exact, including the invoice numbers). How could I make the .transpose function more dynamic so that the entire row is transferred to each new invoice row, instead of grabbing each value from each column (and having 17 lines of code, one for each column)? This additional data would be handled just like the vendor name/number in my example (is repeatable for each new unique invoice number row).

Thanks again in advance!

Gimics,

So that we can get it right on the next try, we would like to see your actual raw data, and, what the results, manually formatted by you, for the results that you are looking for.

You can post your raw data workbook/worksheets to the following free site (sensitive data changed), mark the workbook for sharing, and, provide us with a link to your workbook:

https://dropbox.com