VBA Help on Inventory Sheet

[KB_02]

Need some more help on a VBA that was previously written with the help of forums members here.

I have an inventory workbook with multiple tabs. Currently I am working on an upgrade to the macro that records payments received onto the invoice tab.
Basically, the macro looks at the payment info and compares it to the invoices and looks for a match. If it finds one, it pastes the specifics from that payment onto the invoice tab. And, if it finds a duplicate (double payment), it will add it as an extra line on the invoice tab. Simple, right?

Here is the code:

Sub Payments_Received()
'Payments Received'
Dim ws3 As Worksheet, ws2 As Worksheet
Dim arr3 As Variant, arr4() As Variant
Dim lastRow As Long, i As Long, j As Long, AddRow As Long
Dim tf As Boolean

Application.ScreenUpdating = False
Set ws3 = Sheets("Payments Received")
Set ws2 = Sheets("Invoice Tracking")
lastRow = ws2.Cells(Rows.Count, 1).End(xlUp).Row
AddRow = lastRow
arr3 = ws3.Range(ws3.Cells(12, 1), ws3.Cells(42, 7)).Value
arr4 = ws2.Range(ws2.Cells(2, 1), ws2.Cells(lastRow, 9)).Value

For i = LBound(arr3) To UBound(arr3)
    tf = False
    For j = LBound(arr4, 1) To UBound(arr4, 1)
        If (arr3(i, 1) = arr4(j, 1)) And (arr3(i, 2) = arr4(j, 2)) And arr4(j, 7) = "" And (arr3(i, 7)) = "" Then
            arr4(j, 7) = arr3(i, 3)
            arr4(j, 8) = arr3(i, 4)
            arr4(j, 9) = arr3(i, 5)
'if this is all pasted, add the current date to arr3(i, 7)
    tf = True
        End If
        Next j
    If tf = False And (arr3(i, 7)) = "" Then
            AddRow = AddRow + 1
            ws2.Cells(AddRow, 1) = arr3(i, 1)
            ws2.Cells(AddRow, 2) = arr3(i, 2)
            ws2.Cells(AddRow, 7) = arr3(i, 3)
            ws2.Cells(AddRow, 8) = arr3(i, 4)
            ws2.Cells(AddRow, 9) = arr3(i, 5)
        End If
'if this is all pasted, add the current date to arr3(i, 7)
    Next i
    ws2.Range(ws2.Cells(2, 1), ws2.Cells(lastRow, 9)).Value = arr4

I have noted what I would like to do. Once the payment info has been processed, I would like the macro to add the current date to column 7. Currently I am manually entering the date the payment was processed in this field and if the Macro see something in this field it skips the row and goes onto the next.

Any easy way to make this change?
Thanks, all!
-Bob

 

[JLGWhiz]

I am not sure what "go on to the next" means but this would check column 7 for a value and if none exists, then it would enter the current date, else do nothing.

    If tf = False And (arr3(i, 7)) = "" Then
            AddRow = AddRow + 1
            ws2.Cells(AddRow, 1) = arr3(i, 1)
            ws2.Cells(AddRow, 2) = arr3(i, 2)
            ws2.Cells(AddRow, 7) = arr3(i, 3)
            ws2.Cells(AddRow, 8) = arr3(i, 4)
            ws2.Cells(AddRow, 9) = arr3(i, 5)
            If arr3(i, 7) = "" Then arr3(i, 7) = Date
        End If

 

[KB_02]

I am not sure what "go on to the next" means...

Onto to the next entry for payments. We receive multiple payments at a time and I have a separate macro to print out the information onto a deposit sheet.

I did try what you suggested (your code directly and variations of it) and it doesn't work. The field remains blank. Could it be because the code is basically just looking at inputting information on a different tab?

 

[JLGWhiz]

I should have caught it originally. What you are asking to do is add a value to an existing array, rather than a range. So to solve the issue, I need to know if you want the date entered on ws3 or ws2 and dow you want the entire column to have the date or just a specific row?

 

[KB_02]

That new entry should go on a specific row on ws3.

 

[JLGWhiz]

OK, try this statement.

If ws3.Cells(i + 11, 7) = "" Then ws3.Cells(i + 11, 7) = Date

If you use the j variable then the cell reference would be based on the array LBound. ws3.Cells(j + 1, 7)

 

[KB_02]

Thank you! I got it working with just a little tweeking. Here is what the final code looks like:

For i = LBound(arr3) To UBound(arr3)    tf = False
    For j = LBound(arr4, 1) To UBound(arr4, 1)
        If (arr3(i, 1) = arr4(j, 1)) And (arr3(i, 2) = arr4(j, 2)) And arr4(j, 7) = "" And (arr3(i, 7)) = "" Then
            arr4(j, 7) = arr3(i, 3)
            arr4(j, 8) = arr3(i, 4)
            arr4(j, 9) = arr3(i, 5)
            If ws3.Cells(i + 11, 1) <> "" Then ws3.Cells(i + 11, 7) = Date
        tf = True
        End If
        Next j
    If tf = False And (arr3(i, 7)) = "" Then
            AddRow = AddRow + 1
            ws2.Cells(AddRow, 1) = arr3(i, 1)
            ws2.Cells(AddRow, 2) = arr3(i, 2)
            ws2.Cells(AddRow, 7) = arr3(i, 3)
            ws2.Cells(AddRow, 8) = arr3(i, 4)
            ws2.Cells(AddRow, 9) = arr3(i, 5)
            If ws3.Cells(i + 11, 1) <> "" Then ws3.Cells(i + 11, 7) = Date
        End If
    Next i

One last question I have on this code is this:
While fiddling with this macro to get it to work, I inadvertently swapped the tf = True and End If in the middle of the code above (so the end if came first). This had the effect of DRAMATICALLY increasing the speed of the macro, but the downfall that it would not record duplicate entry (if someone pays twice, we need it recorded). Can't quite wrap my head around why this happened. I would love to keep the speed, but I also need to keep the duplicates. Any ideas?

 

[JLGWhiz]

Good job, thanks for the feedback,
regards, JLG