VBA code / Loop function to match amounts

[RAJESH1960]

Hello experts,
The amounts in column B and C are entered using formula '=RANDBETWEEN(10,90*10)*10. I have to match actual amount with the total as per calculation. The difference must show zero(0). I select the amounts from cell B50 upwards till I get the nearest value of the difference and delete it. Then I enter the difference amount in the last empty column in column B to get zero. I do this for every column in the sheet. There are around 30 columns in each sheet and has 12 months sheet data to be matched. It takes a lot of time. I was hoping whether, if this would be possible with the help of a code, it will save a lot of time.

Code to match amounts.xlsx
	A	B	C	D	E	F	G
1	Apr-20	01-04-2020	02-04-2020		Apr-20	01-04-2020	02-04-2020
2		7770	4540			7770	4540
3	Original Data	8270	5590		Matched Data	8270	5590
4		6400	5110			6400	5110
5		580	5740			580	5740
6		4570	3210			4570	3210
7		4360	500			4360	500
8		4320	850			4320	850
9		3670	5450			3670	5450
10		4280	5000			4280	5000
11		3180	2430			3180	2430
12		7830	320			7830	320
13		2770	2480			2770	2480
14		6230	8300			6230	8300
15		280	4690			280	4690
16		6760	3610			6760	3610
17		8900	500			8900	500
18		990	4340			990	4340
19		7310	410			7310	410
20		4060	6460			4060	6460
21		110	1760			110	1760
22		1570	2310			1570	2310
23		3080	4600			3080	4600
24		350	7040			350	7040
25		7950	120			7950	120
26		1130	5680			310	5680
27		6770	3120				3120
28		8730	1790				1790
29		1590	8450				8450
30		3520	3290				1500
31		1460	7650
32		2250	1910
33		2130	4570
34		6880	4330
35		1480	4530
36		6190	3760
37		360	5610
38		8760	1530
39		1180	4520
40		8530	8740
41		7760	6000
42		8040	7350
43		6330	2210
44		4230	1990
45		7050	8180
46		1570	7350
47		7100	1570
48		1890	7200
49		4330	2950
50		410	3940
51
52	Total As per Calculation	2,15,260.00	2,03,580.00		Total As per Calculation	1,05,900.00	1,05,900.00
53	Actual Amount	1,05,900.00	1,05,900.00		Actual Amount	1,05,900.00	1,05,900.00
54	Difference	1,09,360.00	97,680.00		Difference	-	-
55	207040.00				0.00
56
April workings

Cell Formulas
Range	Formula
B1,F1	B1	=A1
C1,G1	C1	=B1+1
F52:G52,B52:C52	B52	=SUM(B2:B50)
F54:G54,B54:C54	B54	=B52-B53
A55,E55	A55	=SUM(B54:C54)

 

[mackc557]

Select any cell in the first of two columns (ie. column B in your example, or column F if that was another data set.)

Adjust the value of sheet as needed.
The 50 To 2 assumes the same cells used in your example. If your data range is different, change 50 to your last row and 2 to your first row.
The Cells(54, again, assumes the cells used in the example. If your Diffence section is on a different row, change this number to that row number.

This also assumes you has two columns next to each other that need to be calculated.

Please test this on a sample data set first as it removes data.
Let me know if there are any changes that are needed.

Sub Test()
    Dim sheet As Worksheet
    Dim cell As Range
    
    Set sheet = ThisWorkbook.Sheets("Sheet1")
    Set cell = Application.ActiveCell
    
    For i = 50 To 2 Step -1
        If sheet.Cells(54, cell.Column).Value = 0 Then
            Exit For
        ElseIf sheet.Cells(54, cell.Column).Value - sheet.Cells(i, cell.Column).Value > 0 Then
            sheet.Cells(i, cell.Column).Value = ""
        Else
            sheet.Cells(i, cell.Column).Value = sheet.Cells(i, cell.Column).Value - sheet.Cells(54, cell.Column).Value
        End If
    Next i
    
    For i = 50 To 2 Step -1
        If sheet.Cells(54, cell.Column + 1).Value = 0 Then
            Exit For
        ElseIf sheet.Cells(54, cell.Column + 1).Value - sheet.Cells(i, cell.Column + 1).Value > 0 Then
            sheet.Cells(i, cell.Column + 1).Value = ""
        Else
            sheet.Cells(i, cell.Column + 1).Value = sheet.Cells(i, cell.Column + 1).Value - sheet.Cells(54, cell.Column + 1).Value
        End If
    Next i
    
End Sub

 

[RAJESH1960]

First of all I never expected that it is possible. Thanks Mackc557.
Except the first column which represents the date, columns B to AD (depending on the number of days in that month) contains the data to be matched in each sheet. In the above image I have just posted the required answer in columns E F and G. I understand that, I will have to change the number of rows as per my original data base. Will Check and reply back.

 

[RAJESH1960]

First of all I never expected that it is possible. Thanks Mackc557.
Except the first column which represents the date, columns B to AD (depending on the number of days in that month) contains the data to be matched in each sheet. In the above image I have just posted the required answer in columns E F and G. I understand that, I will have to change the number of rows as per my original data base. Will Check and reply back.

Cash sales workings 2020-21.xlsm
	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE
1	01-04-2020	02-04-2020	03-04-2020	04-04-2020	05-04-2020	06-04-2020	07-04-2020	08-04-2020	09-04-2020	10-04-2020	11-04-2020	12-04-2020	13-04-2020	14-04-2020	15-04-2020	16-04-2020	17-04-2020	18-04-2020	19-04-2020	20-04-2020	21-04-2020	22-04-2020	23-04-2020	24-04-2020	25-04-2020	26-04-2020	27-04-2020	28-04-2020	29-04-2020	30-04-2020
2	7770	4540	2950	7590	5260	1670	2090	1780	8860	7950	7590	5260	7770	4540	2950	1670	2090	7590	5260	1670	2090	4540	7770	4540	7590	5260	7770	4540	1670	2090
3	8270	5590	4860	5020	5730	8570	8920	6220	6530	4520	5020	5730	8270	5590	4860	8570	8920	5020	5730	8570	8920	5590	8270	5590	5020	5730	8270	5590	8570	8920
April

The original data is like this and it has more than 600 rows.

 

[RAJESH1960]

Select any cell in the first of two columns (ie. column B in your example, or column F if that was another data set.)

Adjust the value of sheet as needed.
The 50 To 2 assumes the same cells used in your example. If your data range is different, change 50 to your last row and 2 to your first row.
The Cells(54, again, assumes the cells used in the example. If your Diffence section is on a different row, change this number to that row number.

This also assumes you has two columns next to each other that need to be calculated.

Please test this on a sample data set first as it removes data.
Let me know if there are any changes that are needed.

Sub Test()
    Dim sheet As Worksheet
    Dim cell As Range
   
    Set sheet = ThisWorkbook.Sheets("Sheet1")
    Set cell = Application.ActiveCell
   
    For i = 50 To 2 Step -1
        If sheet.Cells(54, cell.Column).Value = 0 Then
            Exit For
        ElseIf sheet.Cells(54, cell.Column).Value - sheet.Cells(i, cell.Column).Value > 0 Then
            sheet.Cells(i, cell.Column).Value = ""
        Else
            sheet.Cells(i, cell.Column).Value = sheet.Cells(i, cell.Column).Value - sheet.Cells(54, cell.Column).Value
        End If
    Next i
   
    For i = 50 To 2 Step -1
        If sheet.Cells(54, cell.Column + 1).Value = 0 Then
            Exit For
        ElseIf sheet.Cells(54, cell.Column + 1).Value - sheet.Cells(i, cell.Column + 1).Value > 0 Then
            sheet.Cells(i, cell.Column + 1).Value = ""
        Else
            sheet.Cells(i, cell.Column + 1).Value = sheet.Cells(i, cell.Column + 1).Value - sheet.Cells(54, cell.Column + 1).Value
        End If
    Next i
   
End Sub

I am getting an error - compile error variable not defined. I think i needs to be defined

 

[RAJESH1960]

I am getting an error - compile error variable not defined. I think i needs to be defined

Seriously man. You are really great. I entered Dim i as integar and changed "Sheets1" to "April Workings" and it worked perfectly. Next I will check in the 30 columns.

 

[RAJESH1960]

Mackc577. The code is running correctly in the first 2 columns only. I added and selected 30 columns, but it is working in the first 2 columns only. How and where do I edit the code for the number of columns. I tried copying and pasting the code from "Next" and pasted it 28 more times. But still it works in the first 2 columns only.

 

[RAJESH1960]

And one more thing in the column where the amount is matched one cell shows zero(0). Can you replace it with blank? When I append all the rows there shouldn't be any 0's in the figures.

Mackc577. The code is running correctly in the first 2 columns only. I added and selected 30 columns, but it is working in the first 2 columns only. How and where do I edit the code for the number of columns. I tried copying and pasting the code from "Next" and pasted it 28 more times. But still it works in the first 2 columns only.

 

[mackc557]

Again, test this on sample data, and I'm not sure why it is requiring you to declare temporary counter variables.

Select a cell within your first column with data. The code will run through every column from the selected column onward.
Again, let me know if you need modifications on this.

Sub Test()
    Dim sheet As Worksheet
    Dim cell As Range
    Dim CellOffset As Integer
    
    Set sheet = ThisWorkbook.Sheets("Sheet1")
    Set cell = Application.ActiveCell
    
    CellOffset = cell.Column
    
    For x = 0 To (sheet.Columns.Count - CellOffset)
        For i = 50 To 2 Step -1
            If sheet.Cells(54, cell.Column + x).Value = 0 Then
                Exit For
            ElseIf sheet.Cells(54, cell.Column + x).Value - sheet.Cells(i, cell.Column + x).Value > 0 Then
                sheet.Cells(i, cell.Column + x).Value = ""
            Else
                sheet.Cells(i, cell.Column + x).Value = sheet.Cells(i, cell.Column + x).Value - sheet.Cells(54, cell.Column + x).Value
            End If
        Next i
    Next x

    
End Sub

 

[RAJESH1960]

Again, test this on sample data, and I'm not sure why it is requiring you to declare temporary counter variables.

Select a cell within your first column with data. The code will run through every column from the selected column onward.
Again, let me know if you need modifications on this.

Sub Test()
    Dim sheet As Worksheet
    Dim cell As Range
    Dim CellOffset As Integer
  
    Set sheet = ThisWorkbook.Sheets("Sheet1")
    Set cell = Application.ActiveCell
  
    CellOffset = cell.Column
  
    For x = 0 To (sheet.Columns.Count - CellOffset)
        For i = 50 To 2 Step -1
            If sheet.Cells(54, cell.Column + x).Value = 0 Then
                Exit For
            ElseIf sheet.Cells(54, cell.Column + x).Value - sheet.Cells(i, cell.Column + x).Value > 0 Then
                sheet.Cells(i, cell.Column + x).Value = ""
            Else
                sheet.Cells(i, cell.Column + x).Value = sheet.Cells(i, cell.Column + x).Value - sheet.Cells(54, cell.Column + x).Value
            End If
        Next i
    Next x

  
End Sub

I am really astonished what all a code can do. I knew that, the work we do for hours, it can do the same work in seconds. But this, it is just awesome. It also does the calculation for us. Thanks Mackc577 for helping to solve this. And more thankful to increase my curiosity to accept more difficult tasks. Your code is perfect Mr.Genius. It doesn't only run in 30 rows but any number of rows. Thanks a ton once again.
To remove the 0's I added this code to your code
Range("B2:B619").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select