Find all records for each vendor on a sheet, and arrange those in columns, with one row for each vendor

FaxMeBeer

New Member
Joined
Apr 20, 2020
Messages
6
Office Version
  1. 2013
Platform
  1. Windows
Sorry for the bad title, I couldn't find a better way, but: I have a sheet that shows outstanding invoices by vendor -- but each vendor has only one record per row, and I need to combine those. So, if the original is:

VendorInvoiceAmount
John1234$500.00
Becky4567$700
Bob4561$300
John4512$200
Kyle1231$100
Kyle4561$150



I need it to be:

VendorInvoice1Amount1Invoice2Amount2
John1234$5004512$200
Becky4567$700
Kyle1231$1004561$150

And so on. In the past, I have copied and then pasted/transpose to do this manually, but now there are too many invoices to do that with efficiently. I cannot find a good enough string of search terms to find anything helpful -- but I'm sure there is some reasonable way to do this.

Any help would be VERY much appreciated!
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,623
Office Version
  1. 2007
Platform
  1. Windows
Assuming your data in columns A, B, C as shown below. The results will be in E1 onwards.

Dante Amor
ABCDEFGHIJKLMN
1VendorInvoiceAmountVendorInvoiceAmountInvoiceAmountInvoiceAmountInvoiceAmount
2John1234500John1234$500.007700$222.004512$200.008899$100.00
3John7700222Becky4567$700.00
4Becky4567700Bob4561$300.00
5Bob4561300Kyle1231$100.004561$150.00
6John4512200
7Kyle1231100
8Kyle4561150
9John8899100
10
Hoja4


Run this macro

VBA Code:
Sub arrange_columns()
  Dim a As Variant, b As Variant, dic As Object
  Dim i As Long, j As Long, k As Long, lr As Long, m As Long, n As Long
  
  lr = Range("A" & Rows.Count).End(3).Row
  a = Range("A2:C" & lr).Value2
  Set dic = CreateObject("Scripting.Dictionary")
  n = Evaluate("=MAX((COUNTIF(A2:A" & lr & ",A2:A" & lr & ")))") * 2 + 1
  ReDim b(1 To UBound(a), 1 To n)
  
  m = 1
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      m = m + 1
      dic(a(i, 1)) = m & "|" & 3
      b(m, 1) = a(i, 1)
      b(m, 2) = a(i, 2)
      b(m, 3) = a(i, 3)
    Else
      k = Split(dic(a(i, 1)), "|")(0)
      j = Split(dic(a(i, 1)), "|")(1)
      b(1, j + 1) = "Invoice"
      b(1, j + 2) = "Amount"
      b(k, j + 1) = a(i, 2)
      b(k, j + 2) = a(i, 3)
      dic(a(i, 1)) = k & "|" & j + 2
    End If
  Next
  Range("E2", Cells(Rows.Count, Columns.Count)).ClearContents
  Range("E1").Resize(m, n).Value = b
  Range("E1:G1").Value = Range("A1:C1").Value
End Sub
 

FaxMeBeer

New Member
Joined
Apr 20, 2020
Messages
6
Office Version
  1. 2013
Platform
  1. Windows
Dante, thank you so much! Hopefully you won't mind answering a few questions about the code you've provided.

I'm not sure what this portion does:

VBA Code:
n = Evaluate("=MAX((COUNTIF(A3:A" & lr & ",A3:A" & lr & ")))") * 2 + 1
  ReDim b(1 To UBound(a), 1 To n)

The next part seems to use "m" to look for a starting point ("1"), and then looks through each vendor name within the array, "i = 1 to UBound(a, 1)", and if the vendor name doesn't exist in the dictionary, then...I'm not sure how this part works (I think this is where it adds the record to the dictionary, but I'm not sure how it works):

VBA Code:
m = m + 1
      dic(a(i, 1)) = m & "|" & 3
      b(m, 1) = a(i, 1)
      b(m, 2) = a(i, 2)
      b(m, 3) = a(i, 3)

Then, if the item is already in the dictionary, it splits the record into the "Invoice" and 'Amount" fields, and pulls those records from the original array, and pasts those into the cell ranges noted at the end.

It will be great if you can help clear up how this works so I can use it effectively in the future. Thanks! I really appreciate your help!
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,623
Office Version
  1. 2007
Platform
  1. Windows
It will be great if you can help clear up how this works

How about:
VBA Code:
Sub arrange_columns()
  Dim a As Variant, b As Variant, dic As Object
  Dim i As Long, j As Long, k As Long, lr As Long, m As Long, n As Long
  
  lr = Range("A" & Rows.Count).End(3).Row
  a = Range("A2:C" & lr).Value2
  Set dic = CreateObject("Scripting.Dictionary")
  
  'The following formula calculates the number of columns that the output will have
  'It gets the maximum number of times that a seller appears,
  'in my example John appears 4 times, multiplies 4 * 2,
  'we need 2 columns one for the Invoice and one for the Amount;
  'and I add 1 column for the vendor.
  'So in this example the maximum of columns is 4 * 2 + 1 = 9
  n = Evaluate("=MAX((COUNTIF(A2:A" & lr & ",A2:A" & lr & ")))") * 2 + 1
  'Redeem the size of the storage capacity of variable b
  '(number of rows starting at 1 and up to the number of elements that variable a has.
  'In this example it has 8 elements, although there are repeated values,
  'the maximum number of rows that could exist are 8.
  'And the number of columns starts at 1 and up to n)
  'redim b(1 to 8, 1 to 9)
  ReDim b(1 To UBound(a), 1 To n)
  
  m = 1
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      'If the vendor does not exist in the index(dictionary),
      'then increase the row number(m),
      m = m + 1
      'add the vendor to the index, but put the data: row and column into that index.
      dic(a(i, 1)) = m & "|" & 3
      'The first time the row is 1, then in b(1, 1) stores the vendor.
      'In b(1, 2) the invoice and in b(1, 3) the amount.
      b(m, 1) = a(i, 1)
      b(m, 2) = a(i, 2)
      b(m, 3) = a(i, 3)
    Else
      'If the vendor does not exist, then
      'split the contents of the index,
      'but in the index I do not have the invoice or the amount stored,
      'what I stored in the index was the row number that corresponds
      '(in the output) to the vendor and how many columns it has used
      '
      'For John's example, (remember) we store 1 "|" 3.
      'So k = 1
      'j = 3
      k = Split(dic(a(i, 1)), "|")(0)
      j = Split(dic(a(i, 1)), "|")(1)
      '
      'This is to put the heading
      b(1, j + 1) = "Invoice"
      b(1, j + 2) = "Amount"
      '
      'In b(k, j + 1) that is b(1, 3 + 1) that is b(1, 4) I put the invoice
      'from a(i, 2) and in b(1, 5) I put the amount from a(i, 3)
      b(k, j + 1) = a(i, 2)
      b(k, j + 2) = a(i, 3)
      'I update the column in John's index, the row is still 1,
      'but the column is now j + 2 = 3 + 2 = 5
      dic(a(i, 1)) = k & "|" & j + 2
    End If
  Next
  Range("E2", Cells(Rows.Count, Columns.Count)).ClearContents
  Range("E1").Resize(m, n).Value = b
  Range("E1:G1").Value = Range("A1:C1").Value
End Sub
 

FaxMeBeer

New Member
Joined
Apr 20, 2020
Messages
6
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Goodness, I feel like I should owe you money. thank you so much!
 

FaxMeBeer

New Member
Joined
Apr 20, 2020
Messages
6
Office Version
  1. 2013
Platform
  1. Windows
Hi Dante, I hope you won't mind helping some more!

My file was quite a bit more robust than my initial question indicated, but after some trial and error, I was able to use your code to do what I needed. Then I came to a new problem :).

once I have consolidated all vendor records onto one row, I needed to change the column heading names so that I could use those as keys for a mail-merge. So, if my first invoice has the heading of "<<Invoice_Number>>", I needed a way to make the second instance "<<Invoice_Number_2>>", and so on. So, I used

VBA Code:
Sub DuplicateColumns()
Dim r As Range:         Set r = Range("T8:TE8")
Dim AR() As Variant:    AR = r.Value
Dim SD As Object:       Set SD = CreateObject("Scripting.Dictionary")


For i = LBound(AR) To UBound(AR, 2)
    If SD.exists(AR(1, i)) Then
        SD(AR(1, i)) = SD(AR(1, i)) + 1 'This was the main part, it added a sequential number to the end of any duplicate column names
        AR(1, i) = AR(1, i) & SD(AR(1, i))
    Else
        SD(AR(1, i)) = 1
    End If
Next i


r.Value = AR
End Sub

This actually did work to add a number to the end of duplicate column names, so that I ended up with "<<Invoice_Number>>2". But, my mail merge doesn't like the "2" being outside of the carrots. So, it just added a 2 to any invoice number (or a 3, 4, 5...etc.). I cannot figure out how to get the sequential number inside the carrots so that my merge will work correctly. I've tried a few things, like:

I tried making the
VBA Code:
SD(AR(1, i)) = SD(AR(1, i)) + 1
read
VBA Code:
SD(AR(1, i)) = "<<" & SD(AR(1, i)) + 1 & ">>"
, but that didn't help. I also tried to do the "+1" as "<<+1>>", but that gave me a type mismatch.

I also tried getting rid of the carrots altogether, and just make the headers read like "Invoice_Number_", so that subsequent results would be like "Invoice_Number_1", "Invoice_Number_2"...but the mail merge again just added the sequential number to the merge field when it imported, so that didn't help.

Would you mind telling me how to achieve this?
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,623
Office Version
  1. 2007
Platform
  1. Windows
If I understood correctly, you have this:
varios 27may2020.xlsm
TUVWXYZAAABACAD
8<<Invoice_Number>><<Invoice_Number>><<Invoice_Number>><<Invoice_Number>><<Invoice_Number>><<Invoice_Number>>
Hoja7


And you want this:
varios 27may2020.xlsm
TUVWXYZAAABACAD
8<<Invoice_Number>><<Invoice_Number_2>><<Invoice_Number_3>><<Invoice_Number_4>><<Invoice_Number_5>><<Invoice_Number_6>>
Hoja7


Then try:
VBA Code:
Sub test()
  Dim c As Range, n As Long
  For Each c In Range("T8:TE8")
    If c.Value = "<<Invoice_Number>>" Then
      n = n + 1
      If n > 1 Then c.Value = "<<Invoice_Number_" & n & ">>"
    End If
  Next
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,130,383
Messages
5,641,835
Members
417,240
Latest member
pjohnsonexcel

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
Top