VBA Combining Information and Totaling a Sum

[bigmacfann]

Hello,

Every month, I get the below table sent to me (Columns A-E) which varies in the number of records it contains. Sometimes there are only 3 or 4 rows of entries, and sometimes there can be as many as 250 rows of entries. After I do my work on the sheet, I am left with what is in Columns G-J. What I am doing is looking for check numbers in Column B which have the same number then combining the Job # in Column I separated with a comma and an ampersand between the last 2 job numbers (as you can see in cell I23. I am also taking the totals in Column E and adding them up into Column J for the check numbers which match. Can anyone help me with a VBA code to do this automatically?

Deposit Detail - October 2024.xlsx
	A	B	C	D	E	F	G	H	I	J
1	Date	Check Num	Name	Job #	Amount		Date	Name	Project #	Amount Paid
2	10/09/2024	9905208109	Contractor 1	24-755	-$2,140.00		10/09/2024	Contractor 1	24-755 & 24-750	$3,590.00
3	10/09/2024	9905208109	Contractor 1	24-750	-$1,450.00		10/09/2024	Contractor 10	24-738	$3,300.00
4	10/09/2024	9363	Contractor 10	24-738	-$3,300.00		10/09/2024	Contractor 11	23-441	$45,584.10
5	10/09/2024	0070782	Contractor 11	23-441	-$45,584.10		10/09/2024	Contractor 14	24-753	$1,200.00
6	10/09/2024	0000005069	Contractor 14	24-753	-$1,200.00		10/09/2024	Contractor 15	23-484	$24,073.20
7	10/09/2024	25433	Contractor 15	23-484	-$24,073.20		10/09/2024	Contractor 16	24-737	$1,380.00
8	10/09/2024	5500	Contractor 16	24-737	-$1,380.00		10/09/2024	Contractor 18	23-629	$13,497.75
9	10/09/2024	18177	Contractor 18	23-629	-$13,497.75		10/09/2024	Contractor 2	24-771	$9,390.00
10	10/09/2024	12127	Contractor 2	24-771	-$9,390.00		10/09/2024	Contractor 20	24-794	$2,060.00
11	10/09/2024	7132	Contractor 20	24-794	-$2,060.00		10/09/2024	Contractor 4	8-241, 14-578 & 18-549	$32,305.00
12	10/09/2024	567316	Contractor 4	8-241	-$25,984.00		10/09/2024	Contractor 7	24-801	$15,000.00
13	10/09/2024	567316	Contractor 4	14-578	-$6,085.00		10/09/2024	Contractor 8	23-624	$11,227.00
14	10/09/2024	567316	Contractor 4	18-549	-$236.00		10/09/2024	Contractor 9	24-639	$48,085.20
15	10/09/2024	47954	Contractor 7	24-801	-$15,000.00		10/25/2024	Contractor 12	24-727	$2,540.00
16	10/09/2024	321107	Contractor 8	23-624	-$11,227.00		10/25/2024	Contractor 13	24-760	$7,800.00
17	10/09/2024	0000009668	Contractor 9	24-639	-$48,085.20		10/25/2024	Contractor 13	24-740	$3,020.00
18	10/25/2024	11497	Contractor 12	24-727	-$2,540.00		10/25/2024	Contractor 13	24-752	$2,340.00
19	10/25/2024	7210511133	Contractor 13	24-760	-$7,800.00		10/25/2024	Contractor 13	24-751	$820.00
20	10/25/2024	7210632222	Contractor 13	24-740	-$3,020.00		10/25/2024	Contractor 13	24-759	$1,870.00
21	10/25/2024	7210632223	Contractor 13	24-752	-$2,340.00		10/25/2024	Contractor 13	24-769	$4,180.00
22	10/25/2024	7210632224	Contractor 13	24-751	-$820.00		10/25/2024	Contractor 15	23-484	$7,002.45
23	10/25/2024	7210839665	Contractor 13	24-759	-$1,870.00		10/25/2024	Contractor 17	24-678, 24-693, 24-679 & 24-725	$39,320.60
24	10/25/2024	7210839670	Contractor 13	24-769	-$4,180.00		10/25/2024	Contractor 19	22-298	$8,215.00
25	10/25/2024	25598	Contractor 15	23-484	-$7,002.45		10/25/2024	Contractor 4	8-241, 14-578 & 18-549	$23,460.00
26	10/25/2024	17338	Contractor 17	24-678	-$11,050.00		10/25/2024	Contractor 5	24-707	$340.00
27	10/25/2024	17338	Contractor 17	24-693	-$8,660.00		10/25/2024	Contractor 5	24-741	$3,150.00
28	10/25/2024	17338	Contractor 17	24-679	-$11,550.60		10/25/2024	Contractor 6	24-690	$15,871.00
29	10/25/2024	17338	Contractor 17	24-679	-$1,380.00		10/31/2024	Contractor 14	24-747	$5,580.00
30	10/25/2024	17338	Contractor 17	24-725	-$6,680.00		10/31/2024	Contractor 14	24-722	$35,046.00
31	10/25/2024	2474	Contractor 19	22-298	-$8,215.00		10/31/2024	Contractor 3	24-765	$7,650.00
32	10/25/2024	570702	Contractor 4	8-241	-$18,375.00
33	10/25/2024	570702	Contractor 4	14-578	-$4,466.00
34	10/25/2024	570702	Contractor 4	18-549	-$619.00
35	10/25/2024	862408284	Contractor 5	24-707	-$340.00
36	10/25/2024	862408286	Contractor 5	24-741	-$3,150.00
37	10/25/2024	07152200	Contractor 6	24-690	-$15,871.00
38	10/31/2024	0000001412	Contractor 14	24-747	-$5,580.00
39	10/31/2024	0000002836	Contractor 14	24-722	-$35,046.00
40	10/31/2024	1111	Contractor 3	24-765	-$7,650.00
Sheet1

 

[DanteAmor]

looking for check numbers in Column B which have the same number

It may be that the same number exists with, for example, 2 different dates, if so what should the macro do?
a) Create 2 records?
b) Create 1 record, but which date to take?

 

[DanteAmor]

If the date is not relevant, try the following macro:

Sub CombiningInformation()
  Dim dic As Object
  Dim a As Variant, b As Variant
  Dim i As Long, y As Long, n As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  
  a = Range("A2", Range("E" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To 4)
  
  Range("G2:J" & Rows.Count).ClearContents
  
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 2)) Then
      dic(a(i, 2)) = dic.Count + 1
    End If
    y = dic(a(i, 2))
    b(y, 1) = a(i, 1)
    b(y, 2) = a(i, 3)
    b(y, 3) = b(y, 3) & ", " & a(i, 4)
    b(y, 4) = b(y, 4) + -a(i, 5)
  Next
  
  For i = 1 To dic.Count
    b(i, 3) = Mid(b(i, 3), 3)
    n = InStrRev(b(i, 3), ",")
    If n > 0 Then b(i, 3) = Left(b(i, 3), n - 1) & Replace(b(i, 3), ",", " &", n)
  Next
  
  Range("G2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

[bigmacfann]

Dim dic As Object Dim a As Variant, b As Variant Dim i As Long, y As Long, n As Long Set dic = CreateObject("Scripting.Dictionary") a = Range("A2", Range("E" & Rows.Count).End(3)).Value ReDim b(1 To UBound(a, 1), 1 To 4) Range("G2:J" & Rows.Count).ClearContents For i = 1 To UBound(a, 1) If Not dic.exists(a(i, 2)) Then dic(a(i, 2)) = dic.Count + 1 End If y = dic(a(i, 2)) b(y, 1) = a(i, 1) b(y, 2) = a(i, 3) b(y, 3) = b(y, 3) & ", " & a(i, 4) b(y, 4) = b(y, 4) + -a(i, 5) Next For i = 1 To dic.Count b(i, 3) = Mid(b(i, 3), 3) n = InStrRev(b(i, 3), ",") If n > 0 Then b(i, 3) = Left(b(i, 3), n - 1) & Replace(b(i, 3), ",", " &", n) Next Range("G2").Resize(UBound(b, 1), UBound(b, 2)).Value = b

I get a type mismatch on line b(y, 4) = b(y, 4) + -a(i, 5)

 

[bigmacfann]

It may be that the same number exists with, for example, 2 different dates, if so what should the macro do?
a) Create 2 records?
b) Create 1 record, but which date to take?

If multiple jobs were paid by the same check, the date will always be the same (because it's 1 check). One thing to note is that 1 check could have paid the same job multiple times, but I do not need the same job number listed more than once in Column I; I do, however, still need the total to get added to the sum in Column J.

 

[DanteAmor]

I get a type mismatch on line b(y, 4) = b(y, 4) + -a(i, 5)

That's because in column E you have text instead of numerical values.

Run the macro again, when the error occurs, press the Debug button, on the line highlighted in yellow, bring the mouse pointer closer to the letter "y". A small window will appear with text like the one in the following image:

After the "y" a number appears, add 1 to that number, in that line, in column "E" of your Excel sheet you have a text.

Check that in column E all are numerical values.


------------------------------------------

One thing to note is that 1 check could have paid the same job multiple times, but I do not need the same job number listed more than once in Column I; I do, however, still need the total to get added to the sum in Column J.

For that, try: this:

Sub CombiningInformation()
  Dim dic As Object
  Dim a As Variant, b As Variant
  Dim i As Long, y As Long, n As Long
 
  Set dic = CreateObject("Scripting.Dictionary")
  a = Range("A2", Range("E" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To 4)
  Range("G2:J" & Rows.Count).ClearContents
 
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 2)) Then
      dic(a(i, 2)) = dic.Count + 1
    End If
    y = dic(a(i, 2))
    b(y, 1) = a(i, 1)
    b(y, 2) = a(i, 3)
    If InStr(1, b(y, 3), a(i, 4), vbTextCompare) = 0 Then
      b(y, 3) = b(y, 3) & ", " & a(i, 4)
    End If
    b(y, 4) = b(y, 4) + -a(i, 5)
  Next
 
  For i = 1 To dic.Count
    b(i, 3) = Mid(b(i, 3), 3)
    n = InStrRev(b(i, 3), ",")
    If n > 0 Then b(i, 3) = Left(b(i, 3), n - 1) & Replace(b(i, 3), ",", " &", n)
  Next
 
  Range("G2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

[bigmacfann]

After the "y" a number appears, add 1 to that number, in that line, in column "E" of your Excel sheet you have a text.

Everything in Column E is formatted as Currency. When I hit debug, it had an issue with y=31 so I went to E32 and it was formatted as Currency (-18375)

 

[DanteAmor]

E32 and it was formatted as Currency (-18375)

Maybe that number is stored as text, or maybe it has whitespace on the right or left.

Try the following macro to try to solve the problem with your data.

Sub CombiningInformation()
  Dim dic As Object
  Dim a As Variant, b As Variant
  Dim i As Long, y As Long, n As Long
  Dim aux As Variant, ch As String
  
  Set dic = CreateObject("Scripting.Dictionary")
  
  a = Range("A2", Range("E" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To 4)
  
  Range("G2:J" & Rows.Count).ClearContents
  
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 2)) Then
      dic(a(i, 2)) = dic.Count + 1
    End If
    y = dic(a(i, 2))
    b(y, 1) = a(i, 1)
    b(y, 2) = a(i, 3)
    If InStr(1, b(y, 3), a(i, 4), vbTextCompare) = 0 Then
      b(y, 3) = b(y, 3) & ", " & a(i, 4)
    End If
    
    aux = Replace(Replace(Replace(a(i, 5), "$", ""), " ", ""), Chr(160), "")
    If IsNumeric(aux) Then
      b(y, 4) = b(y, 4) + -aux
    Else
      ch = ch & "E" & i + 1 & vbCr
    End If
  Next
  
  For i = 1 To dic.Count
    b(i, 3) = Mid(b(i, 3), 3)
    n = InStrRev(b(i, 3), ",")
    If n > 0 Then b(i, 3) = Left(b(i, 3), n - 1) & Replace(b(i, 3), ",", " &", n)
  Next
  
  Range("G2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  If ch <> "" Then MsgBox "Cells with error: " & vbCr & ch
End Sub

If the problem with your data continues. To continue with the test. Delete the rows from the cell with error downwards. Try the macro again to see the results.

Analyze the cell with error, check that it really is a number, edit the cell and then press enter. Or delete the content and manually type the number.

All of the above is simply to verify your data.