VBA matching, data manipulation across different worksheets

[Sandler]

I am trying to do an upload to let a general ledger system know when checks are paid (reconciled).
To do so, I must upload all checks that are not left outstanding on the bank reconciliation.
If a check is on the bank reconciliation, I need to remove it from the Bank History report that shows all checks issued.

There are multiple entities 8100, 8200, 8300, etc. The tabs that have the same exact sheet name (8100, 8200, 8300 etc.) is the bank history report formatted for the upload to work. They have Check numbers in column C and amounts in column F.

The outstanding check worksheets are entitled 8100 Rec, 8200 Rec, 8300 Rec, etc. (short for Reconciliation). In those sheets the Check number is in column A and amounts are in column B.
I am looking for VBA code that will have 2 parts.

1) Go through the worksheets, wherever it sees a tab name with 4 numbers, match it up to the 4 number + Rec tab. i.e. 8100 to 8100 Rec, 8200 to 8200 Rec.

2) Then if a check and amount from the Rec tab matches up with a check and amount from the matching tab (i.e. 8100 Rec to 8100). I want the check and matching amount to be deleted from the matching tab (i.e. 8100)

Below is an example of the original sheet with check number in C and amounts in F.




*
A
B
C
D
E
F


1
8100
CHK
18719
*
11/28/2014
15


2
8100
CHK
19449
*
1/2/2015
20


3
8100
CHK
20187
*
2/12/2015
20

[SamT]

Please verify:
You have Entity tabs (ex Named "8100")
You have Reconciled Checks tabs(ex: Named "8100 Rec")
If an Entity Tab Record, (Check No and amt) matches a Reconciled Record, you want to delete the Record from the Entity tab.

What to do if the two Check Amounts do not match?


Please upload a sample xlsm book with two ea Rec Tabs and 2 ea Entity tabs, with at least three matching Checks in each pair. Delete or obfuscate any personal information. All that is needed is the Ck# and amount.

[Sandler]

Thanks, SamT. You are correct in the 8100 and 8100 Rec and correct in that i want to delete the row from the entity tab when found on the rec because the check is still outstanding. If there is no match on the Rec sheet, than do nothing. How do I upload sample workbooks to the forum? So far I have written some code that may work, but i am getting a ByRef argument type mismatch error. Please, see code below. Thanks :)


Option Explicit

Sub ReconcilingChecks()
Dim numSheets As Integer
Dim a, b As Integer

numSheets = ActiveWorkbook.Worksheets.Count
For a = 1 To numSheets
For b = 1 To numSheets

If Worksheets(a).Name = Left(Worksheets(a).Name, 4) Then
checkBankRec a, b
Exit For
End If
Next b
Next a
End Sub



Sub checkBankRec(a As Integer, b As Integer)
Dim wsh1 As Worksheet
Dim wsh2 As Worksheet

Set wsh1 = Worksheets(a)
Set wsh2 = Worksheets(b)

If wsh1.Name = Left(wsh1.Name, 4) Then Exit Sub
Dim row As Integer
Dim numRows As Integer
Dim check As String
Dim amount As Long

For row = 1 To wsh1.Cells(1, 1).End(xlDown).row
check = wsh1.Cells(row, 1).Value 'check in column A
amount = wsh1.Cells(row, 2).Value 'check in column B
verifyCheckAmount check, amount, wsh2
Next row
End Sub


Sub verifyCheckAmount(check As String, amount As Long, wsh As Worksheet)
Dim row As Integer
Dim numRows As Integer
Dim check1 As String
Dim amount1 As Long

For row = 1 To wsh.Cells(1, 1).End(xlDown).row
check1 = wsh.Cells(row, 3).Value 'check in column C
amount1 = wsh.Cells(row, 6).Value 'check in column F
If check1 = check And amount1 = amount Then
'if you just need to delete the amount and check
wsh.Cells(row, 3).clearcontent
wsh.Cells(row, 6).clearcontent
'if you delete the content of the entire row => wsh.rows(row).clearcontent
End If
Next row
End Sub

[Sandler]

Thanks, SamT. You are correct in the 8100 and 8100 Rec and correct in that i want to delete the row from the entity tab when found on the rec because the check is still outstanding. If there is no match on the Rec sheet, than do nothing. How do I upload sample workbooks to the forum? So far I have written some code that may work, but i am getting a ByRef argument type mismatch error. Please, see code below. Thanks :)


Option Explicit


Sub ReconcilingChecks()


Dim numSheets As Integer


Dim a, b As Integer


numSheets = ActiveWorkbook.Worksheets.Count


For a = 1 To numSheets


For b = 1 To numSheets

If Worksheets(a).Name = Left(Worksheets(a).Name, 4) Then


checkBankRec a, b


Exit For


End If


Next b


Next a


End Sub


Sub checkBankRec(a As Integer, b As Integer)


Dim wsh1 As Worksheet


Dim wsh2 As Worksheet


Set wsh1 = Worksheets(a)


Set wsh2 = Worksheets(b)


If wsh1.Name = Left(wsh1.Name, 4) Then Exit Sub


Dim row As Integer


Dim numRows As Integer


Dim check As String


Dim amount As Long


For row = 1 To wsh1.Cells(1, 1).End(xlDown).row


check = wsh1.Cells(row, 1).Value 'check in column A


amount = wsh1.Cells(row, 2).Value 'check in column B


verifyCheckAmount check, amount, wsh2


Next row


End Sub


Sub verifyCheckAmount(check As String, amount As Long, wsh As Worksheet)


Dim row As Integer


Dim numRows As Integer


Dim check1 As String


Dim amount1 As Long


For row = 1 To wsh.Cells(1, 1).End(xlDown).row


check1 = wsh.Cells(row, 3).Value 'check in column C


amount1 = wsh.Cells(row, 6).Value 'check in column F


If check1 = check And amount1 = amount Then


'delete the amount and check


wsh.Cells(row, 3).clearcontent


wsh.Cells(row, 6).clearcontent

End If


Next row


End Sub

[SamT]

"Dim A, B as Integer" is the same as Dim A As Variant, B as Integer. (Only the last is is specifically Typed.)

Assuming that the Rec sheets may be fewer than the Entity sheets

Sub ReconcilingChecks()
Dim numSheets As Integer
Dim Rec As Long

numSheets = ActiveWorkbook.Worksheets.Count
For Rec = 1 To numSheets

If Len(Worksheets(Rec).Name > 4 then
checkBankRec Rec, Left(sheets(a).Name, 4)
'Exit For
End If
Next a
End Sub


Sub checkBankRec(Rec As Long, Ent As String)
Dim wsh1 As Worksheet
Dim wsh2 As Worksheet
Dim Rw As Long 'Always declare Sheet, Row, and Column counters as longs. Never use Keywords as variable names.
Dim check As String
Dim amount As Long

Set wsh1 = Worksheets(Rec)
Set wsh2 = Worksheets(Ent)


For Rw = 1 To wsh1.Cells(1, 1).End(xlDown)Row
check = wsh1.Cells(Rw, 1).Value 'check in column A
amount = wsh1.Cells(Rw, 2).Value 'check in column B
verifyCheckAmount check, amount, wsh2
Next row
End Sub



Sub verifyCheckAmount(check As String, amount As Double, wsh As Worksheet)
'Decimal numbers require Type "Double "

Dim Rw as Long
Dim amount1 As Double

Rw = wsh.Range("C:C").Find(check).rw 'Much faster than looking at all Rows.

If Rw = 0 then
MsgBox "Check #" & check & " was not found on sheet " & wsh.Name
Exit Sub
End If

amount1 = wsh.Cells(Rw, 6).Value 'check in column F
If amount1 <> amount Then
MsgBox "There is a discrepancy in the Amount of Check #" & check & _
" Of Account # " & wsh.Name"
Exit Sub
End If

'if you just need to delete the amount and check
wsh.Cells(Rw, 3).clearcontent
wsh.Cells(Rw, 6).clearcontent
'if you delete the content of the entire row => wsh.rows(rw).clearcontent
End If
End Sub

Very nice coding.

[Sandler]

Thank you SamT, I appreciate your code, it looks more concise.

I am currently getting the following error after the changes.

Invalid Next Control Variable Reference

And it is saying that it relates to the following code.


Next a

[SamT]

Change the "a" to "Rec"in the For. . . Next loop, because I didn't change all instances of "a" to "Rec". :banghead:

Maybe you should doublecheck all my edits :devil2: :D

Actually the "a" in "Next a" is only a reminder to the programmer of which "For" that "Next" belongs with. You can leave that reminder off in all For. . . Loops

For A = 1 to 100
.
.
.
Next

I even add a reminder to my With. . . End With loops

With X
.
.
.
End With 'X

[Sandler]

I finally got the code to run, but I must have messed something up in my code while doing so.
It seems to be taking the 8100 - Bank History Report and simply deleting every transaction.
I had to use the original code for the 3rd sub, as it was getting too difficult to clear the errors on the msgbox code.

Please, advise. Thanks :)


Option Explicit




Sub ReconcilingChecks()
Dim numSheets As Integer
Dim Rec As Long

numSheets = ActiveWorkbook.Worksheets.Count
For Rec = 1 To numSheets

If Len(Worksheets(Rec).Name > 4) Then
checkBankRec Rec, Left(Sheets(Rec).Name, 4)
'Exit For
End If
Next Rec
End Sub


Sub checkBankRec(Rec As Long, Ent As String)
Dim wsh1 As Worksheet
Dim wsh2 As Worksheet
Dim Rw As Long 'Always declare Sheet, Row, and Column counters as longs. Never use Keywords as variable names.
Dim check As String
Dim amount As Long

Set wsh1 = Worksheets(Rec)
Set wsh2 = Worksheets(Ent)


For Rw = 1 To wsh1.Cells(1, 1).End(xlDown)
check = wsh1.Cells(Rw, 1).Value 'check in column A
amount = Val(wsh1.Cells(Rw, 2).Value) 'check in column B
verifyCheckAmount check, amount, wsh2
Next Rw
End Sub


Sub verifyCheckAmount(check As String, amount As Long, wsh As Worksheet)
Dim Rw As Single
Dim nRows As Integer
Dim check1 As String
Dim amount1 As Long

For Rw = 1 To wsh.Cells(1, 1).End(xlDown).row
check1 = wsh.Cells(Rw, 3).Value 'check in column C
amount1 = wsh.Cells(Rw, 6).Value 'check in column F

If check1 = check And amount1 = amount Then
'if you just need to delete the amount and check
'wsh.Cells(row, 3).clearcontent
'wsh.Cells(row, 6).clearcontent
wsh.Rows(Rw).ClearContents
End If
Next Rw
End Sub

[SamT]

This is the only syntax error I saw in your code : Close Paren in wrong place, in first sub.

If Len(Worksheets(Rec).Name) > 4


Note that my use of .End(xlDown) in the second sub was based on the assumption that there will never be a gap in the list of checks in Rec.

I assume that you could not get the Find method in the third sub to work for you.

I am not familiar with the Val function in this line

amount = Val(wsh1.Cells(Rw, 2).Value)


If you must loop thru all the checks in the Entity, this will be better

With Wsh
For Rw = 1 To .Cells(Rows.Count, 1).End(xlUp).Row 'Must look from bottom, 'cuz some checks have cleared
check1 = wsh.Cells(Rw, 3).Value 'check in column C
amount1 = wsh.Cells(Rw, 6).Value 'check in column F

If Cells(Rw, 3).Value = check Then
If .Cells(Rw, 6).Value = amount Then
.Rows(Rw).ClearContents
Exit Sub 'done with this check
Else
MsgBox "There is a discrepancy in the Amount of Check #" & check & _
" Of Account # " & wsh.Name"
Exit Sub
End If
End If
Next Rw
End With
'Been thru all the Rows, but. . .
MsgBox "Check #" & Check & " Was not Found!"
EndSub



Using Cells(Row, Column).End(xlDirection) is like using Ctrl+arrow key.

xlUp will stop at the first used cell above the starting Cell. Cell(Rows.Count, Column) is the very last cell in Column
xlDown will stop above the first unused cell below the starting cell. if there are more used cells below that, they are ignored.
xlToRight and xlToLeft act the same way.

That is not a complete explanation. Experiment with Ctrl+Arrow keys for full understanding

[Sandler]

I realized that the check amounts would be the same on the outstanding check list and the bank report. ​But for some reason the code only works on the first set of tabs and not the other 2 sets. Is there something wrong with my first sub procedure? Should i just create an inputbox that calculates the tabs as i input the information?

Option Explicit

Sub ReconcilingChecks()
Dim numSheets As Integer
Dim Rec As Long

numSheets = ActiveWorkbook.Worksheets.Count
For Rec = 1 To numSheets

If Len(Worksheets(Rec).Name) > 4 Then
checkBankRec Rec, Left(Sheets(Rec).Name, 4)
'Exit For
End If
Next Rec
End Sub


Sub checkBankRec(Rec As Long, Ent As String)
Dim wsh1 As Worksheet
Dim wsh2 As Worksheet
Dim Rw As Long 'Always declare Sheet, Row, and Column counters as longs. Never use Keywords as variable names.
Dim check As String
Dim amount As Long

Set wsh1 = Worksheets(Rec)
Set wsh2 = Worksheets(Ent)


For Rw = 1 To wsh1.Cells(1, 1).End(xlDown)
check = wsh1.Cells(Rw, 1).Value 'check in column A
verifyCheckAmount check, wsh2
Next Rw
End Sub


Sub verifyCheckAmount(check As String, wsh As Worksheet)
Dim Rw As Single
Dim nRows As Integer
Dim check1 As String
Dim amount1 As Long

With wsh
For Rw = 1 To .Cells(Rows.Count, 1).End(xlUp).Row 'Must look from bottom, 'cuz some checks have cleared
check1 = wsh.Cells(Rw, 3).Value 'check in column C

If Cells(Rw, 3).Value = check Then
.Rows(Rw).ClearContents
Exit Sub

End If

Next Rw
End With

End Sub

[SamT]

If this doesn't work, don't delete this original code, just comment out what you change and add the changes. Please tell us what line errors out and what the Error message was when you post the code.

Note that it is not tested or even compiled. I am not using the VBA editor on this computer.


Sub ReconcilingChecks()
Dim Rec As Worksheet

For Each Rec In Worksheets
'uncomment after testing
'If Len(Rec.Name) > 4 Then checkBankRec Rec, Left(Rec.Name, 4)

''''Remove after testing. This will loop thru all the Rec sheets without calling the next sub'''
If Len(Rec.Name) > 4 Then MsgBox "Reconcile Sheet: " & Rec & vbCrLf _
& "Entity Sheet: " & Left(Rec.Name, 4)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''
Next Rec
End Sub



Sub checkBankRec(Rec As Worksheet, EntName As String)
Dim Rw As Long
Dim checknum As String
Dim amount As Double

''''''''''Remove after testing. This will show each Rec sheet name'''''''''
MsgBox "Checking Reconciliation Sheet " & Rec.Name
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''

With Rec
For Rw = 1 To .Cells(1, "A").End(xlDown)
checknum = .Cells(Rw, "A").Value 'check in column A
amount = .Cells(Rw, "B") 'Always verify amount to prevent fraud 'Adjust Column to suit
ReconcileCheck amount checknum, EntName
Next Rw
End With
End Sub



Sub ReconcileCheck(amount as Double, checknum As String, EntName As String)
Dim Rw As Long

'''''''''Remove this block after testing. This will show each Entity sheet name.''''''''''
Static shtname as String
If Not shtname = EntName Then 'Only show msgbox once per entity
MsgBox "Reconciling a check on sheet " & EntName
shtname = EntName
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''

With Sheets(EntName)
For Rw = 1 To .Cells(Rows.Count, "C").End(xlUp).Row 'Must look from bottom, 'cuz some checks have cleared
If .Cells(Rw, "C") = checknum Then
If .Cells(Rw, "D") <> amount Then 'Adjust Column to suit
MsgBox "HELP! Thief! " & EntName & " - " & checknum
.activate
.Cells(Rw, "C").Select
Stop 'Stop all code.Exit all Subs
Else
.Rows(Rw).ClearContents
Exit Sub
End If
End If
Next Rw
End With

'Been thru all the Rows, but. . .
MsgBox "Check #" & checknum & " Was not Found On " & EntName & "!"
End Sub

[Sandler]

Thanks, i am getting an object doesn't support this property or method on the following code: MsgBox "Reconcile Sheet: " & Rec & vbCrLf & "Entity Sheet: " & Left(Rec.Name, 4)

[SamT]

That's the problem with not being able to use the VBA Editor. Can't test it to find those little omissions.

Put a ".Name" after the "Rec".

"Rec" is an Object, (Worksheet,) not a String. The ".Name" will return the name, (String,) of the Object.

[Sandler]

Thank you SamT, that fixed the error. I am learning a significant amount from you and I appreciate it :)
Do you know why i am getting a Syntax Error with
ReconcileCheck amount checknum, EntName

[SamT]

No comma after "amount".

All parameters passed to a Procedure must be separated by commas.

If the procedure returns a value, the Parameters must be enclosed in parentheses.

Sub Test()
Dim Response as long

MsgBox "This MsgBox does not return a value"

Response = MsgBox("This one does", vbYesNoCancel)

MsgBox "The value of the button you clicked in the last message is " & Response

End Sub

[Sandler]

Thanks that was an easy one, I should have picked up on.
The program is not making any changes to the original sheets.

I think i have a quicker way of solving this, but need help with the coding.
At this point, i realize that the check amounts will always be the same. It is the bank producing the check and the bank clearing the check.
I can run an IFERROR(VLOOKUP(single check amount on 8100, columns A:B on 8100 Rec, 2,0),0)
Then i can filter, by amounts that returned a value other than 0, and get rid of them (since they matched)

When i ran the macro recorder, it gave me strange code that had arrays of all the amount values, so i can't use the recorder for this one.

How can i create this code, and then make it loop for the other sheets?

P.S. - I don't need any messageboxes :)

[SamT]

At this point, i realize that the check amounts will always be the same. It is the bank producing the check and the bank clearing the check. In that case, I have some beach front property in AZ. that i would like to sell really cheap.


I think i have a quicker way of solving this,
Go for it.

[Sandler]

I appreciate the help, and didn't mean anything bad by it. I am simply saying that i can compare the information by check # only.
If i can figure out how to get the program to go through all the sheets running this vlookup with deletion, I will post it here.
Thanks.

[SamT]

welcome

[Sandler]

I got what i was looking for. Here is the code. It's simplified in that it doesn't loop through the tabs, but I currently have 6 entities to do this for, so i will gladly repeat the code. Thanks again for your help SamT.


Option Explicit


Sub DeleteMatchingItems()
' Defines variables
Dim Cell As Range, cRange As Range, sRange As Range, Rng As Range, FindString As String
Dim Round1 As Long, Round2 As Long
Dim Round3 As Long, Round4 As Long
Dim Round5 As Long, Round6 As Long




' Defines last row of sheets 1 and 2
Round1 = Sheets("8605").Cells(Rows.Count, "C").End(xlUp).row
Round2 = Sheets("8605 Rec").Cells(Rows.Count, "A").End(xlUp).row




' Sets range to check for as Sheet2 A1 to last row
Set cRange = Sheets("8605 Rec").Range("A1:A" & Round2)
' Sets search range as Sheet1 A2 to last row
Set sRange = Sheets("8605").Range("C1:C" & Round1)




' For each cell in the check range
For Each Cell In cRange
' String to find equals cell value
FindString = Cell.Value
' With the search range
With sRange
' Set Rng as the cell where the value is found
Set Rng = .Find(What:=FindString, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
' If Rng exists then
If Not Rng Is Nothing Then
' Delete the entire row on sheet 1
Rng.EntireRow.Delete
End If
End With
' Move to next cell in check range
Next Cell




' Optional message box to confirm all cells have been checked and copied if required
MsgBox "Action Completed 1"


' Defines last row of sheets 3 and 4
Round3 = Sheets("1234").Cells(Rows.Count, "C").End(xlUp).row
Round4 = Sheets("1234 Rec").Cells(Rows.Count, "A").End(xlUp).row




' Sets range to check for as Sheet2 A1 to last row
Set cRange = Sheets("1234 Rec").Range("A1:A" & Round4)
' Sets search range as Sheet1 A2 to last row
Set sRange = Sheets("1234").Range("C1:C" & Round3)




' For each cell in the check range
For Each Cell In cRange
' String to find equals cell value
FindString = Cell.Value
' With the search range
With sRange
' Set Rng as the cell where the value is found
Set Rng = .Find(What:=FindString, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
' If Rng exists then
If Not Rng Is Nothing Then
' Delete the entire row on sheet 1
Rng.EntireRow.Delete
End If
End With
' Move to next cell in check range
Next Cell




' Optional message box to confirm all cells have been checked and copied if required
MsgBox "Action Completed 2"


' Defines last row of sheets 5 and 6
Round5 = Sheets("5678").Cells(Rows.Count, "C").End(xlUp).row
Round6 = Sheets("5678 Rec").Cells(Rows.Count, "A").End(xlUp).row




' Sets range to check for as Sheet2 A1 to last row
Set cRange = Sheets("5678 Rec").Range("A1:A" & Round6)
' Sets search range as Sheet1 A2 to last row
Set sRange = Sheets("5678").Range("C1:C" & Round5)




' For each cell in the check range
For Each Cell In cRange
' String to find equals cell value
FindString = Cell.Value
' With the search range
With sRange
' Set Rng as the cell where the value is found
Set Rng = .Find(What:=FindString, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
' If Rng exists then
If Not Rng Is Nothing Then
' Delete the entire row on sheet 1
Rng.EntireRow.Delete
End If
End With
' Move to next cell in check range
Next Cell




' Optional message box to confirm all cells have been checked and copied if required
MsgBox "Action Completed 3"
End Sub

[SamT]

Code that you understand is much preferred over efficient code.