Bank Reconciliation
Solved/Closed
MRafik
Posts
24
Registration date
Wednesday January 9, 2013
Status
Member
Last seen
November 25, 2013
-
Aug 23, 2013 at 02:11 PM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Nov 26, 2013 at 11:00 AM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Nov 26, 2013 at 11:00 AM
Related:
- Bank Reconciliation
- Fenix internet on bank statement - Guide
- Application for bank statement sbi - Guide
- Credit summation of bank account formula - Guide
- Google play refund to bank - Guide
- Best neo bank - Guide
31 responses
TrowaD
Posts
2921
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 27, 2022
555
Oct 7, 2013 at 11:11 AM
Oct 7, 2013 at 11:11 AM
Hi MRafik,
1) Another good find. To solve this adjust the 2nd code line:
Best regards,
Trowa
1) Another good find. To solve this adjust the 2nd code line:
Dim mMonth, lRow, x As Integer, MySumRec, MySumPay, OB As Long
into:
Dim mMonth, lRow, x As Integer, MySumRec, MySumPay, OB As Currency
2) No problem, just insert the following before the last code line (which is End Sub):
lRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A26:F" & lRow).Sort Key1:=Range("B26"), Order1:=xlAscending
Best regards,
Trowa
MRafik
Posts
24
Registration date
Wednesday January 9, 2013
Status
Member
Last seen
November 25, 2013
Oct 10, 2013 at 09:20 AM
Oct 10, 2013 at 09:20 AM
Hi Trowa
Thank you for all the help.
Everything is working fine except a slight problem.
The problem is when there is no DATE in an uncleared item then everything goes out of zinc. Is it possible to change order to however the uncleared items are firstly on the opening balance sheet and then on Rec01 and Pay01 and so on.
Going one step ahead what would be the best way to use a userform for data entry when batches are involved.
Kind Regards
Rafik
Thank you for all the help.
Everything is working fine except a slight problem.
The problem is when there is no DATE in an uncleared item then everything goes out of zinc. Is it possible to change order to however the uncleared items are firstly on the opening balance sheet and then on Rec01 and Pay01 and so on.
Going one step ahead what would be the best way to use a userform for data entry when batches are involved.
Kind Regards
Rafik
TrowaD
Posts
2921
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 27, 2022
555
Oct 10, 2013 at 10:46 AM
Oct 10, 2013 at 10:46 AM
Hi Rafik,
Not entirely, we can sort on column A first and then on column B. Last code line would then be:
Opening Balance will then be first, but then all the Pay's and then all the Rec's.
About the Userform, check out this site which explains nicely how to set up and work with an Userform:
https://www.excel-easy.com/vba/userform.html
Let me know if more guidance is desired.
Best regards,
Trowa
Not entirely, we can sort on column A first and then on column B. Last code line would then be:
Range("A26:F" & lRow).Sort Key1:=Range("A26"), Key2:=Range("B26"), Order1:=xlAscending
Opening Balance will then be first, but then all the Pay's and then all the Rec's.
About the Userform, check out this site which explains nicely how to set up and work with an Userform:
https://www.excel-easy.com/vba/userform.html
Let me know if more guidance is desired.
Best regards,
Trowa
MRafik
Posts
24
Registration date
Wednesday January 9, 2013
Status
Member
Last seen
November 25, 2013
Oct 26, 2013 at 09:19 AM
Oct 26, 2013 at 09:19 AM
Hi Trowa
Just wondered whether it was passible to use filter, copy and paste in our macro
for the uncleared items in the order opening balance then Rec01 then
Pay01 and so on.
This would avoid the rows going out of zinc.
Kind Regards
Rafik
Just wondered whether it was passible to use filter, copy and paste in our macro
for the uncleared items in the order opening balance then Rec01 then
Pay01 and so on.
This would avoid the rows going out of zinc.
Kind Regards
Rafik
TrowaD
Posts
2921
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 27, 2022
555
Oct 29, 2013 at 12:43 PM
Oct 29, 2013 at 12:43 PM
Hi Rafik,
I think I got it.
First I determined at which row the Rec's and Pay's start. Then I used column G (hopefully it is still empty) to put in a formula to determine the number. Then sort on the number and then on the date. Finally remove the formula's from column G.
The above is automated in the code below:
Trowa
I think I got it.
First I determined at which row the Rec's and Pay's start. Then I used column G (hopefully it is still empty) to put in a formula to determine the number. Then sort on the number and then on the date. Finally remove the formula's from column G.
The above is automated in the code below:
Sub Reconcile()Best regards,
Dim mMonth, fRow, lRow, x As Integer, MySumRec, MySumPay, OB As Currency
TryAgain:
mMonth = Application.InputBox("Enter month number (1-12) for which you want to reconcile")
If mMonth = False Or mMonth = vbNullString Or mMonth < 1 Or mMonth > 12 Then
MsgBox "No valid entry has been made, you either:" & Chr(10) & _
"- Input a 0" & Chr(10) & "- Input nothing" & Chr(10) & "- Hit the cancel button" _
& Chr(10) & "- Input a number smaller then 1 or bigger then 12", , "Invalid entry"
Z = MsgBox("Would you like to try again?", vbYesNo)
If Z = vbYes Then GoTo TryAgain
Exit Sub
End If
Range("A26:F" & Rows.Count).ClearContents
x = mMonth
If mMonth = 1 Then
Range("B3").Value = Sheets("Opening Balances").Range("E1").Value
Else: OB = Sheets("Opening Balances").Range("E1").Value
Do
mMonth = mMonth - 1
lRow = Sheets("Rec" & mMonth).Range("E" & Rows.Count).End(xlUp).Row
If lRow > 2 Then
For Each cell In Sheets("Rec" & mMonth).Range("E3:E" & lRow)
OB = OB + cell.Value
Next
End If
Loop Until mMonth = 1
mMonth = x
Do
mMonth = mMonth - 1
lRow = Sheets("Pay" & mMonth).Range("E" & Rows.Count).End(xlUp).Row
If lRow > 2 Then
For Each cell In Sheets("Pay" & mMonth).Range("E3:E" & lRow)
OB = OB - cell.Value
Next
End If
Loop Until mMonth = 1
Range("B3").Value = OB
End If
mMonth = x
lRow = Sheets("Rec" & mMonth).Range("E" & Rows.Count).End(xlUp).Row
For Each cell In Sheets("Rec" & mMonth).Range("E3:E" & lRow)
MySumRec = MySumRec + cell.Value
Next
If IsNumeric(MySumRec) = False Then MySumRec = 0
Range("B4").Value = MySumRec
lRow = Sheets("Pay" & mMonth).Range("E" & Rows.Count).End(xlUp).Row
For Each cell In Sheets("Pay" & mMonth).Range("E3:E" & lRow)
MySumPay = MySumPay + cell.Value
Next
If IsNumeric(MySumPay) = False Then MySumPay = 0
Range("B5").Value = MySumPay
Range("B9").Value = Range("B6").Value
MySumRec = 0
Do
lRow = Sheets("Rec" & mMonth).Range("E" & Rows.Count).End(xlUp).Row
If lRow > 2 Then
For Each cell In Sheets("Rec" & mMonth).Range("E3:E" & lRow)
If cell.Offset(0, -2) = vbNullString And cell <> vbNullString Then
MySumRec = MySumRec + cell.Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = "Rec" & mMonth
Sheets("Bank Reconciliation").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, -4).Value
Sheets("Bank Reconciliation").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, -3).Value
Sheets("Bank Reconciliation").Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, -1).Value
Sheets("Bank Reconciliation").Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = "(" & cell.Value & ")"
End If
Next
End If
mMonth = mMonth - 1
Loop Until mMonth = 0
lRow = Sheets("Opening Balances").Range("E" & Rows.Count).End(xlUp).Row
If lRow > 4 Then
For Each cell In Sheets("Opening Balances").Range("E5:E" & lRow)
If cell.Offset(0, -2) = vbNullString And cell <> vbNullString Then
MySumRec = MySumRec + cell.Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = "Opening Balances"
Sheets("Bank Reconciliation").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, -4).Value
Sheets("Bank Reconciliation").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, -3).Value
Sheets("Bank Reconciliation").Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, -1).Value
Sheets("Bank Reconciliation").Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = "(" & cell.Value & ")"
End If
Next
End If
Range("B10").Value = MySumRec
MySumPay = 0
mMonth = x
Do
lRow = Sheets("Pay" & mMonth).Range("E" & Rows.Count).End(xlUp).Row
If lRow > 2 Then
For Each cell In Sheets("Pay" & mMonth).Range("E3:E" & lRow)
If cell.Offset(0, -2) = vbNullString And cell <> vbNullString Then
MySumPay = MySumPay + cell.Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = "Pay" & mMonth
Sheets("Bank Reconciliation").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, -4).Value
Sheets("Bank Reconciliation").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, -3).Value
Sheets("Bank Reconciliation").Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, -1).Value
Sheets("Bank Reconciliation").Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Value
End If
Next
End If
mMonth = mMonth - 1
Loop Until mMonth = 0
lRow = Sheets("Opening Balances").Range("K" & Rows.Count).End(xlUp).Row
If lRow > 4 Then
For Each cell In Sheets("Opening Balances").Range("K5:K" & lRow)
If cell.Offset(0, -2) = vbNullString And cell <> vbNullString Then
MySumPay = MySumPay + cell.Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = "Opening Balances"
Sheets("Bank Reconciliation").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, -4).Value
Sheets("Bank Reconciliation").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, -3).Value
Sheets("Bank Reconciliation").Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, -1).Value
Sheets("Bank Reconciliation").Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Value
End If
Next
End If
Range("B11").Value = MySumPay
lRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A26:F" & lRow).Sort Key1:=Range("A26"), Key2:=Range("B26"), Order1:=xlAscending
fRow = 25
Do
fRow = fRow + 1
Loop Until Range("A" & fRow) <> "Opening Balances"
If fRow <> lRow Then
For Each cell In Range(Cells(fRow, "A"), Cells(lRow, "A"))
cell.Offset(0, 6).Formula = "=right(A" & cell.Row & ",len(A" & cell.Row & ")-3)"
Next cell
Range(Cells(fRow, "A"), Cells(lRow, "G")).Sort Key1:=Range("G" & fRow), Key2:=Range("B" & fRow), Order1:=xlAscending
End If
Range(Cells(fRow, "G"), Cells(lRow, "G")).ClearContents
End Sub
Trowa
Hi Trowa
I tried the updated code but still out of zinc
I have uploaded a revised file on speedy.share
http://speedy.sh/JtdbC/Cash-Book-Rec.xlsm
<a href="http://speedy.sh/JtdbC/Cash-Book-Rec.xlsm">Download at SpeedyShare</a>
http://speedy.sh/JtdbC/Cash-Book-Rec.xlsm
in which i have highlighted the result of using the filter, copy and paste method manually against using the macro and you will notice the various differences of how they go out of zinc .
Hope you can help me solve this.
Kind regards
Rafik
I tried the updated code but still out of zinc
I have uploaded a revised file on speedy.share
http://speedy.sh/JtdbC/Cash-Book-Rec.xlsm
<a href="http://speedy.sh/JtdbC/Cash-Book-Rec.xlsm">Download at SpeedyShare</a>
http://speedy.sh/JtdbC/Cash-Book-Rec.xlsm
in which i have highlighted the result of using the filter, copy and paste method manually against using the macro and you will notice the various differences of how they go out of zinc .
Hope you can help me solve this.
Kind regards
Rafik
TrowaD
Posts
2921
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 27, 2022
555
Nov 5, 2013 at 11:13 AM
Nov 5, 2013 at 11:13 AM
Hi Rafik,
*) It seems I made a fatal mistake in creating the uncleared items list. Fixed it now though.
*) Added the condition that the total amount cannot be 0 if it wants to be on the uncleared items list.
*) Removed the second filter condition (filter on dates).
Try this code:
Trowa
*) It seems I made a fatal mistake in creating the uncleared items list. Fixed it now though.
*) Added the condition that the total amount cannot be 0 if it wants to be on the uncleared items list.
*) Removed the second filter condition (filter on dates).
Try this code:
Sub Reconcile()Best regards,
Dim mMonth, fRow, lRow, x As Integer, MySumRec, MySumPay, OB As Currency
TryAgain:
mMonth = Application.InputBox("Enter month number (1-12) for which you want to reconcile")
If mMonth = False Or mMonth = vbNullString Or mMonth < 1 Or mMonth > 12 Then
MsgBox "No valid entry has been made, you either:" & Chr(10) & _
"- Input a 0" & Chr(10) & "- Input nothing" & Chr(10) & "- Hit the cancel button" _
& Chr(10) & "- Input a number smaller then 1 or bigger then 12", , "Invalid entry"
Z = MsgBox("Would you like to try again?", vbYesNo)
If Z = vbYes Then GoTo TryAgain
Exit Sub
End If
Range("A26:F" & Rows.Count).ClearContents
x = mMonth
If mMonth = 1 Then
Range("B3").Value = Sheets("Opening Balances").Range("E1").Value
Else: OB = Sheets("Opening Balances").Range("E1").Value
Do
mMonth = mMonth - 1
lRow = Sheets("Rec" & mMonth).Range("E" & Rows.Count).End(xlUp).Row
If lRow > 2 Then
For Each cell In Sheets("Rec" & mMonth).Range("E3:E" & lRow)
OB = OB + cell.Value
Next
End If
Loop Until mMonth = 1
mMonth = x
Do
mMonth = mMonth - 1
lRow = Sheets("Pay" & mMonth).Range("E" & Rows.Count).End(xlUp).Row
If lRow > 2 Then
For Each cell In Sheets("Pay" & mMonth).Range("E3:E" & lRow)
OB = OB - cell.Value
Next
End If
Loop Until mMonth = 1
Range("B3").Value = OB
End If
mMonth = x
lRow = Sheets("Rec" & mMonth).Range("E" & Rows.Count).End(xlUp).Row
For Each cell In Sheets("Rec" & mMonth).Range("E3:E" & lRow)
MySumRec = MySumRec + cell.Value
Next
If IsNumeric(MySumRec) = False Then MySumRec = 0
Range("B4").Value = MySumRec
lRow = Sheets("Pay" & mMonth).Range("E" & Rows.Count).End(xlUp).Row
For Each cell In Sheets("Pay" & mMonth).Range("E3:E" & lRow)
MySumPay = MySumPay + cell.Value
Next
If IsNumeric(MySumPay) = False Then MySumPay = 0
Range("B5").Value = MySumPay
Range("B9").Value = Range("B6").Value
MySumRec = 0
Do
lRow = Sheets("Rec" & mMonth).Range("E" & Rows.Count).End(xlUp).Row
If lRow > 2 Then
For Each cell In Sheets("Rec" & mMonth).Range("E3:E" & lRow)
If cell.Offset(0, -2) = vbNullString And cell <> vbNullString And cell <> 0 Then
MySumRec = MySumRec + cell.Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = "Rec" & mMonth
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = cell.Offset(0, -4).Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = cell.Offset(0, -3).Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = cell.Offset(0, -1).Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = "(" & cell.Value & ")"
End If
Next
End If
mMonth = mMonth - 1
Loop Until mMonth = 0
lRow = Sheets("Opening Balances").Range("E" & Rows.Count).End(xlUp).Row
If lRow > 4 Then
For Each cell In Sheets("Opening Balances").Range("E5:E" & lRow)
If cell.Offset(0, -2) = vbNullString And cell <> vbNullString And cell <> 0 Then
MySumRec = MySumRec + cell.Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = "Opening Balances"
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = cell.Offset(0, -4).Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = cell.Offset(0, -3).Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = cell.Offset(0, -1).Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = "(" & cell.Value & ")"
End If
Next
End If
Range("B10").Value = MySumRec
MySumPay = 0
mMonth = x
Do
lRow = Sheets("Pay" & mMonth).Range("E" & Rows.Count).End(xlUp).Row
If lRow > 2 Then
For Each cell In Sheets("Pay" & mMonth).Range("E3:E" & lRow)
If cell.Offset(0, -2) = vbNullString And cell <> vbNullString And cell <> 0 Then
MySumPay = MySumPay + cell.Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = "Pay" & mMonth
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = cell.Offset(0, -4).Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = cell.Offset(0, -3).Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = cell.Offset(0, -1).Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = cell.Value
End If
Next
End If
mMonth = mMonth - 1
Loop Until mMonth = 0
lRow = Sheets("Opening Balances").Range("K" & Rows.Count).End(xlUp).Row
If lRow > 4 Then
For Each cell In Sheets("Opening Balances").Range("K5:K" & lRow)
If cell.Offset(0, -2) = vbNullString And cell <> vbNullString And cell <> 0 Then
MySumPay = MySumPay + cell.Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = "Opening Balances"
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = cell.Offset(0, -4).Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = cell.Offset(0, -3).Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = cell.Offset(0, -1).Value
Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = cell.Value
End If
Next
End If
Range("B11").Value = MySumPay
lRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A26:F" & lRow).Sort Key1:=Range("A26"), Order1:=xlAscending
fRow = 25
Do
fRow = fRow + 1
Loop Until Range("A" & fRow) <> "Opening Balances"
If fRow <> lRow Then
For Each cell In Range(Cells(fRow, "A"), Cells(lRow, "A"))
cell.Offset(0, 6).Formula = "=right(A" & cell.Row & ",len(A" & cell.Row & ")-3)"
Next cell
Range(Cells(fRow, "A"), Cells(lRow, "G")).Sort Key1:=Range("G" & fRow), Order1:=xlAscending
End If
Range(Cells(fRow, "G"), Cells(lRow, "G")).ClearContents
End Sub
Trowa
MRafik
Posts
24
Registration date
Wednesday January 9, 2013
Status
Member
Last seen
November 25, 2013
Nov 12, 2013 at 02:26 PM
Nov 12, 2013 at 02:26 PM
Hi Trowa
Thank you for all your help
Everything is working perfectly except one little hitch is that the list of unreconciled items goes from sheet
Opening Balance then 10, then 11, then 12, then 1, 2 ,3 , etc
Is it possible to have the unreconciled list from sheet Opening Balance and then 1,2,3 and ending at 12.
Once again thank you
Kind regards
Mrafik
Thank you for all your help
Everything is working perfectly except one little hitch is that the list of unreconciled items goes from sheet
Opening Balance then 10, then 11, then 12, then 1, 2 ,3 , etc
Is it possible to have the unreconciled list from sheet Opening Balance and then 1,2,3 and ending at 12.
Once again thank you
Kind regards
Mrafik
TrowaD
Posts
2921
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 27, 2022
555
Nov 18, 2013 at 11:04 AM
Nov 18, 2013 at 11:04 AM
Hi Rafik,
Time to handle it a bit differently.
First we create a custom list.
This isn't difficult and is shown here:
https://contexturesblog.com/archives/2010/03/10/sort-it-your-way-with-excel-custom-lists/
Your custom list would look like:
Opening Balances
Rec1
Pay1
Rec2
Pay2
Rec3
Pay3
Rec4
Pay4
Rec5
Pay5
Rec6
Pay6
Rec7
Pay7
Rec8
Pay8
Rec9
Pay9
Rec10
Pay10
Rec11
Pay11
Rec12
Pay12
Now count at which position your custom list is.
To clarify; The "Pens, Paper, File Folders, Staplers"-list is at position 7 in the above link.
This number needs to correspond with the number (bold and underlined) in the code below second to last line:
Range("A26:F" & lRow).Sort Key1:=Range("A26"), Order1:=xlAscending, OrderCustom:=7
Here is the code:
Best regards,
Trowa
Time to handle it a bit differently.
First we create a custom list.
This isn't difficult and is shown here:
https://contexturesblog.com/archives/2010/03/10/sort-it-your-way-with-excel-custom-lists/
Your custom list would look like:
Opening Balances
Rec1
Pay1
Rec2
Pay2
Rec3
Pay3
Rec4
Pay4
Rec5
Pay5
Rec6
Pay6
Rec7
Pay7
Rec8
Pay8
Rec9
Pay9
Rec10
Pay10
Rec11
Pay11
Rec12
Pay12
Now count at which position your custom list is.
To clarify; The "Pens, Paper, File Folders, Staplers"-list is at position 7 in the above link.
This number needs to correspond with the number (bold and underlined) in the code below second to last line:
Range("A26:F" & lRow).Sort Key1:=Range("A26"), Order1:=xlAscending, OrderCustom:=7
Here is the code:
Sub Reconcile() Dim mMonth, fRow, lRow, x As Integer, MySumRec, MySumPay, OB As Currency TryAgain: mMonth = Application.InputBox("Enter month number (1-12) for which you want to reconcile") If mMonth = False Or mMonth = vbNullString Or mMonth < 1 Or mMonth > 12 Then MsgBox "No valid entry has been made, you either:" & Chr(10) & _ "- Input a 0" & Chr(10) & "- Input nothing" & Chr(10) & "- Hit the cancel button" _ & Chr(10) & "- Input a number smaller then 1 or bigger then 12", , "Invalid entry" Z = MsgBox("Would you like to try again?", vbYesNo) If Z = vbYes Then GoTo TryAgain Exit Sub End If Range("A26:F" & Rows.Count).ClearContents x = mMonth If mMonth = 1 Then Range("B3").Value = Sheets("Opening Balances").Range("E1").Value Else: OB = Sheets("Opening Balances").Range("E1").Value Do mMonth = mMonth - 1 lRow = Sheets("Rec" & mMonth).Range("E" & Rows.Count).End(xlUp).Row If lRow > 2 Then For Each cell In Sheets("Rec" & mMonth).Range("E3:E" & lRow) OB = OB + cell.Value Next End If Loop Until mMonth = 1 mMonth = x Do mMonth = mMonth - 1 lRow = Sheets("Pay" & mMonth).Range("E" & Rows.Count).End(xlUp).Row If lRow > 2 Then For Each cell In Sheets("Pay" & mMonth).Range("E3:E" & lRow) OB = OB - cell.Value Next End If Loop Until mMonth = 1 Range("B3").Value = OB End If mMonth = x lRow = Sheets("Rec" & mMonth).Range("E" & Rows.Count).End(xlUp).Row For Each cell In Sheets("Rec" & mMonth).Range("E3:E" & lRow) MySumRec = MySumRec + cell.Value Next If IsNumeric(MySumRec) = False Then MySumRec = 0 Range("B4").Value = MySumRec lRow = Sheets("Pay" & mMonth).Range("E" & Rows.Count).End(xlUp).Row For Each cell In Sheets("Pay" & mMonth).Range("E3:E" & lRow) MySumPay = MySumPay + cell.Value Next If IsNumeric(MySumPay) = False Then MySumPay = 0 Range("B5").Value = MySumPay Range("B9").Value = Range("B6").Value MySumRec = 0 Do lRow = Sheets("Rec" & mMonth).Range("E" & Rows.Count).End(xlUp).Row If lRow > 2 Then For Each cell In Sheets("Rec" & mMonth).Range("E3:E" & lRow) If cell.Offset(0, -2) = vbNullString And cell <> vbNullString And cell <> 0 Then MySumRec = MySumRec + cell.Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = "Rec" & mMonth Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = cell.Offset(0, -4).Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = cell.Offset(0, -3).Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = cell.Offset(0, -1).Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = "(" & cell.Value & ")" End If Next End If mMonth = mMonth - 1 Loop Until mMonth = 0 lRow = Sheets("Opening Balances").Range("E" & Rows.Count).End(xlUp).Row If lRow > 4 Then For Each cell In Sheets("Opening Balances").Range("E5:E" & lRow) If cell.Offset(0, -2) = vbNullString And cell <> vbNullString And cell <> 0 Then MySumRec = MySumRec + cell.Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = "Opening Balances" Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = cell.Offset(0, -4).Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = cell.Offset(0, -3).Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = cell.Offset(0, -1).Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = "(" & cell.Value & ")" End If Next End If Range("B10").Value = MySumRec MySumPay = 0 mMonth = x Do lRow = Sheets("Pay" & mMonth).Range("E" & Rows.Count).End(xlUp).Row If lRow > 2 Then For Each cell In Sheets("Pay" & mMonth).Range("E3:E" & lRow) If cell.Offset(0, -2) = vbNullString And cell <> vbNullString And cell <> 0 Then MySumPay = MySumPay + cell.Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = "Pay" & mMonth Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = cell.Offset(0, -4).Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = cell.Offset(0, -3).Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = cell.Offset(0, -1).Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = cell.Value End If Next End If mMonth = mMonth - 1 Loop Until mMonth = 0 lRow = Sheets("Opening Balances").Range("K" & Rows.Count).End(xlUp).Row If lRow > 4 Then For Each cell In Sheets("Opening Balances").Range("K5:K" & lRow) If cell.Offset(0, -2) = vbNullString And cell <> vbNullString And cell <> 0 Then MySumPay = MySumPay + cell.Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = "Opening Balances" Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = cell.Offset(0, -4).Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = cell.Offset(0, -3).Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = cell.Offset(0, -1).Value Sheets("Bank Reconciliation").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = cell.Value End If Next End If Range("B11").Value = MySumPay lRow = Range("A" & Rows.Count).End(xlUp).Row Range("A26:F" & lRow).Sort Key1:=Range("A26"), Order1:=xlAscending, OrderCustom:=7 End Sub
Best regards,
Trowa
MRafik
Posts
24
Registration date
Wednesday January 9, 2013
Status
Member
Last seen
November 25, 2013
Nov 25, 2013 at 12:02 PM
Nov 25, 2013 at 12:02 PM
Thank You Trowa
Am trying to sort out the userform
Best Regards
Am trying to sort out the userform
Best Regards
TrowaD
Posts
2921
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 27, 2022
555
Nov 26, 2013 at 11:00 AM
Nov 26, 2013 at 11:00 AM
Glad to read that.
I'm here for you if you need further assistance.
Best regards
I'm here for you if you need further assistance.
Best regards