Ideas to help modified code to work with different conditions

[Oberon70]

I previously was provided with a code that took the information from a table with the below structure:

Claim Number	Amount	INVOICE ID	TRANSACTION TYPE
ID5045	20	9893	Trust Payment
ID5046	-20	9893	Trust Payment
ID5039	80	9893	Trust Payment
ID4892	-383.04	8314	Commission
ID4899	100	8314	Trust Payment
ID4892	497.46	8314	Trust Payment
ID5001	-20	8314	Trust Payment
ID5020	-889.52	8315	Commission
ID5021	-48.11	8315	Commission
ID5022	-81.59	8315	Commission
ID5023	-36.26	8315	Commission
ID5025	-888.03	8315	Commission
ID5021	97.19	8315	Trust Payment
ID5022	164.82	8315	Trust Payment
ID5023	73.24	8315	Trust Payment
ID5025	1794	8315	Trust Payment
ID5026	300	8348	Trust Payment
ID5027	-67.2	8348	Trust Payment

However, this worked well, when I was processing a full statement. Now, my work has implemented auto receipting and I receive a Data file that has a list of all the rejected transactions. This file can be made up of different agents and invoice numbers, plus can have transaction reversals.

I have written code to load the Data file and insert the information into a table. The table looks like the below:

Rejected Transactions - Consolidated
CLAIM NUMBER	Agency Name	AMOUNT	INVOICE ID	TRANSACTION TYPE
ID5041	Star Interprise Inc	20	9893	Trust Payment
ID5045	Star Interprise Inc	20	9893	Trust Payment
ID5046	Star Interprise Inc	-20	9893	Trust Payment
ID5039	Star Interprise Inc	80	9893	Trust Payment
ID4892	Star Labs	-383.04	8314	Commission
ID4899	Star Labs	100	8314	Trust Payment
ID4892	Star Labs	497.46	8314	Trust Payment
ID5005	Star Labs	-530	8314	Trust Payment
ID5022	Star Labs	-81.59	8315	Commission
ID5023	Star Labs	-36.26	8315	Commission
ID5025	Star Labs	-888.03	8315	Commission
ID5021	Star Labs	97.19	8315	Trust Payment
ID5022	Star Labs	164.82	8315	Trust Payment
ID5023	Star Labs	73.24	8315	Trust Payment
ID5025	Star Labs	1794	8315	Trust Payment
ID5026	Star Labs	300	8348	Trust Payment
ID5027	Star Labs	-67.2	8348	Trust Payment
ID3005	Star Labs	-27.5	8354	Commission
ID300909	Star Labs	-11	8354	Commission
ID0010200132	Star Labs	-766.15	8359	Commission
ID5036	Star Labs	-297.77	8359	Commission
ID5037	Star Labs	-7.7	8359	Commission
ID5036	Star Labs	773.43	8359	Trust Payment
ID0010200132	Star Labs	1990	8359	Trust Payment
ID5038	Star Labs	-49.5	8361	Commission
ID0010224563	Star Labs	-59.4	8361	Commission
ID5038	Star Labs	100	8361	Trust Payment
ID0010224563	Star Labs	120	8361	Trust Payment
ID5043	Wayne Enterprise	-77	11093	Commission
ID5044	Wayne Enterprise	-3080	11093	Commission
ID5047	Wayne Enterprise	-38.5	11093	Commission
ID5039	Wayne Enterprise	320	11093	Trust Payment
ID5041	Wayne Enterprise	80	11093	Trust Payment
ID5044	Wayne Enterprise	8000	11093	Trust Payment
ID5046	Wayne Enterprise	-40	11093	Trust Payment
ID5047	Wayne Enterprise	100	11093	Trust Payment

Original.xlsm
	A	B	C						I																	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ
1	Claim Number	Amount	Inc Comm																								Star Labs 9893
2	ID5005	10	-4.55																								Click Me		KID5005	10
3	ID5006	20	-10.55																										KID5006	20
4	ID5008	30	-16.55																										KID5008	30
5	ID5010	40	-22.55																										KID5010	40
6	ID5011	50	-28.55																										KID5011	50
7	ID5012	60	-34.55																										KID5012	60
8	ID5013	70	-40.55																										KID5013	70
9	ID5015	80	-46.55																										KID5015	80
10	ID5018	90	-52.55																										KID5018	90
11	ID5019	100	-58.55																										KID5019	100
12	ID5020	110	-64.55																										KID5020	110
13	ID5021	120	-70.55																										KID5021	120
14	ID5022	130	-76.55																										KID5022	130
15	ID5023	140	-82.55																										KID5023	140
16	ID5025	150	-88.55																										KID5025	150
17	ID5006	160	-94.55																										KID5006	160
18	ID5010	170	-100.55
19	ID5011	180	-106.55																								Click Me		N1ID5005		90p		4.55		3Commission
20	ID5012	190	-112.55																								Click Me		N1ID5013		90p		40.55		3Commission
21	ID5013	200	-118.55																								Click Me		N1ID5022		90p		76.55		3Commission
22	ID5015	210	-124.55
23	ID5018	220	-130.55
24	ID5019	230	-136.55																								Click Me		-10		payment ID5005
25	ID5021	240	-142.55																										-4.55		Commission
26	ID5022	250	-148.55																										-20		payment ID5006
27	ID5023	260	-154.55																										-10.55		Commission
28	ID5025	270	-160.55																										-30		payment ID5008
29	ID5026	280	-166.55																										-16.55		Commission
30	ID5027	290	-172.55																										-40		payment ID5010
31	ID5028	300	-178.55																										-22.55		Commission
32	ID5029	310	-184.55																										-50		payment ID5011
33	ID5031	320	-190.55																										-28.55		Commission
34	ID5032	330	-196.55																										-60		payment ID5012
35	ID5033	340	-202.55																										-34.55		Commission
36	ID5034	350	-208.55
37	ID3005	360	-214.55																								Click Me		-70		payment ID5013
38	ID5036	370	-220.55																										-40.55		Commission
39	ID5037	380	-226.55																										-80		payment ID5015
40	ID5036	390	-232.55																										-46.55		Commission
41	ID5026	400	-238.55																										-90		payment ID5018
42	ID5037	410	-244.55																										-52.55		Commission
43	ID5038	420	-250.55																										-100		payment ID5019
44	ID5038	430	-256.55																										-58.55		Commission
45	ID5039	440	-262.55																										-110		payment ID5020
46	ID5041	450	-268.55																										-64.55		Commission
47	ID5043	460	-274.55																										-120		payment ID5021
48	ID5043	470	-280.55																										-70.55		Commission
49	ID5044	480	-286.55
50	ID5044	490	-292.55																								Click Me		-130		payment ID5022
51	ID5045	500	-298.55																										-76.55		Commission
52	ID5046	510	-304.55																										-140		payment ID5023
53	ID5047	520	-310.55																										-82.55		Commission
54	ID5047	530	-316.55																										-150		payment ID5025
55	ID5041	540	-322.55																										-88.55		Commission
56	ID5045	550	-328.55																										-160		payment ID5006
57	ID5046	560	-334.55																										-94.55		Commission
58	ID5039	570	-340.55						Receipt Num																		Hide me
Rapid Receipting

The 1st section is for payments only. So, the max amount of payments is 16 and the payments can not be a negative amount (reversal).

Original.xlsm
	AA	AB	AC	AD
1	Star Labs 9893
2	Click Me		KID5005	10
3			KID5006	20
4			KID5008	30
5			KID5010	40
6			KID5011	50
7			KID5012	60
8			KID5013	70
9			KID5015	80
10			KID5018	90
11			KID5019	100
12			KID5020	110
13			KID5021	120
14			KID5022	130
15			KID5023	140
16			KID5025	150
17			KID5006	160
Rapid Receipting

the 2nd section was originally only for commission but now will need to include payment reversals and commission.

Original.xlsm
	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO
19	Click Me		N1ID5005		90p		-4.55		3Commission		N1ID5006		90p		-10.55
20	Click Me		K1ID5013		95p		-40.55		4Payment		K1ID5015		95p		-46.55
Rapid Receipting

the third section is fine as it is just the previous data but in reverse. i.e. payment $10.00 would be -10.00 in section three.

Original.xlsm
	AA	AB	AC	AD	AE
24	Click Me		-10		payment ID5005
25			-4.55		Commission
26			-20		payment ID5006
27			-10.55		Commission
28			-30		payment ID5008
29			-16.55		Commission
30			-40		payment ID5010
31			-22.55		Commission
32			-50		payment ID5011
33			-28.55		Commission
34			-60		payment ID5012
35			-34.55		Commission
Rapid Receipting

The original code is:

Sub RapidReceipting()

     Dim i0, i, i1, s, iSet, iTotal, a, O1(), O2(), O3(), sh, Lrow
     Dim AbrAgntNme As String
     Dim wsInvDTL As Worksheet
     Dim wsSpdRcpt As Worksheet
     Dim wb As Workbook
     
     Set wb = ActiveWorkbook
     Set wsInvDTL = wb.Sheets("Invoice Details")
     Set wsSpdRcpt = wb.Sheets("Rapid Receipting")
     
     AbrAgntNme = wb.Sheets("Invoice Details").Range("B1")
     
     iSet = 16                                                  'groupsize

     With Range("TBL_Claims").ListObject
          a = .DataBodyRange.Value                              'read the values of this table (size unknown)
          Set sh = .Parent                                      'the sheet, that range (listobject) is in
     End With

     sh.UsedRange.Offset(, 9).Clear                             'Contents                     'clear everything at the RHS of our table

     For i = 0 To (UBound(a) - 1) / iSet                        'outer loop for the sets of 16
          ReDim O1(1 To iSet, 1 To 2)                           'start with fresh (=empty) & correct sized arrays !!!
          ReDim O2(1 To WorksheetFunction.RoundUp((iSet - 1) / 6, 0), 1 To 24)
          ReDim O3(1 To 3 * iSet, 1 To 2)

     '1st part = make per 16 3 sets of arrays (O1 to O3) ready for output
     '***************************************************
          For i1 = 1 To iSet                                    'inner loop (until 16 in case of a complete set)

               ptr = i * iSet + i1                              'pointer to know the right row in a
               If ptr > UBound(a) Then Exit For
     '1st array =16 rows with claimcounter and amount
               O1(i1, 1) = "K" & a(ptr, 1)
               O1(i1, 2) = a(ptr, 2)

     '2nd array=3 rows * 6 columns "N" & claimnumber

               ptr1 = (i1 - 1) \ 6: ptr2 = i1 - (ptr1 * 6)
               ptr3 = 1 + ptr1: ptr4 = (ptr2 - 1) * 4 + 1

               O2(ptr3, ptr4) = "N1" & a(ptr, 1)
               O2(ptr3, ptr4 + 1) = "90p"
               O2(ptr3, ptr4 + 2) = a(ptr, 3)
               O2(ptr3, ptr4 + 3) = "3Commission"

     '3rd array=alternate -amount & "payment"   /    + inc Comm & "commission"
               O3((i1 - 1) * 2 + 1, 1) = -a(ptr, 2)
               O3((i1 - 1) * 2 + 1, 2) = "payment " & a(ptr, 1)
               O3(i1 * 2, 1) = a(ptr, 3)
               O3(i1 * 2, 2) = "Commission"
          Next

     '2nd part = write those 3 arrays (O1 to O3) to the sheet
     '***************************************************
          With sh.Cells(1 + 60 * i, "AA")
               .Value = wsInvDTL.Range("B1").Value & " " & wsInvDTL.Range("B2").Value
               .Offset(1, 2).Resize(UBound(O1), UBound(O1, 2)).Value = O1     '1st array = claimcounter & amount
               With .Offset(18, 2)                              '2nd array
                    For i3 = 1 To UBound(O2, 2)                 'loop tthrough all columns in the array
                         With .Offset(, 2 * (i3 - 1)).Resize(3, 1)     'skip everytime a column
                              .Value = Application.Index(O2, 0, i3)     'column with values
                              .Offset(, 1).Interior.Color = IIf(i3 = UBound(O2, 2), RGB(255, 0, 0), IIf(i3 Mod 4 = 0, RGB(0, 255, 0), RGB(200, 200, 200)))     'next columns with backgroundcolor
                         End With
                    Next

               End With
               
               With .Offset(23, 2)
                    For i3 = 1 To 3
                         With .Offset((i3 - 1) * 13).Resize(12, 3)
                              .Value = Application.Index(O3, WorksheetFunction.Sequence(12, 1, (i3 - 1) * 12 + 1), Array(1, 2, 2))     'copy the 2nd column twice as column 2 and 3
                              .Columns(2).ClearContents         'delete the 2nd column
                         End With
                    Next
               End With
               

               With .Range("A2,A19:A21,A24,A37,A50")
                    .Value = "Click Me"
                    .Interior.Color = vbYellow
               End With
               
               With .Range("A58")
                    .Value = "Hide me"
                    .Interior.Color = vbRed
               End With
               
              wsSpdRcpt.Range("A58").Offset(0, 8) = "Receipt Num"
               

               With .Offset(58).Resize(, 60).Borders(xlEdgeBottom)
                    .LineStyle = xlDouble
                    .Color = -16776961
                    .Weight = xlThick
               End With
             
          End With
          
     Next
     
     'wsRcptRpt.Range("B4").FormulaR1C1 = "=SUM(TBL_Claims[Amount])-SUM(TBL_Claims[Inc Comm])"
     'wsSpdRcpt.Range("A2").Offset(0, 8) = "Date"
     'wsSpdRcpt.Range("A3").Offset(0, 8) = "Batch"

     With sh.UsedRange.EntireColumn
          .ColumnWidth = 2
          .AutoFit                                              'adjust columnwidth
     End With
     sh.Columns("A:Y").EntireColumn.Hidden = True

End Sub

Any ideas on how to do the above would be great. I have been away from work on medical leave for two weeks due to surgery and getting this change will help me go through all the rejected transactions Data files and quickly get them receipted to the system.