Need VBA Code for Inventory Sheet

[KB_02]

Hello all. This is my first port here and I am hoping you can help. I am writing an inventory sheet for my company to track some serialized items. In this sheet, I need to include a tracking page for every item sold (easy, I've done that part), as well as a sheet to track voided (damaged/returned) items. I have found a simple way to do this through VLookUp, but as I could literally have hundreds of thousands of rows on my tracking sheet, copying a formula down to the bottom of the sheet makes the sheet so big that simple calculations take 5 minutes. I need to write a VBA Macro for this purpose.

While I love Excel and have become a pretty good wiz at using formulas, I must admit that I am nearly clueless when it comes to VBA.

Here is what I want to do:
- Look at the value in cell A4 (starting cell) on sheet “Voids” and find that value in Column B onsheet “Tracking.”
If Value is found in "Tracking," type in “Voided” in column D in the samerow as where the value is in column B.
- Then, loop down to A5 on "Voids" and repeat and keep looping and repeating until all lines on "Voids" have been accounted for.

ALSO, add to this mess, as this will be a new tracking system, we may get some items back where the serial number is not on this tracking sheet. I am assuming I can add an IF function to simply go on to the next line if the number is not found?

 

[KB_02]

Just bumping the post...

 

[tonyyy]

KB_02,

Welcome to the Board.

You might consider the following...

Sub ArrayLoop_1069822()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim arr1 As Variant, arr2 As Variant
Dim lastRow As Long, i As Long, j As Long

Application.ScreenUpdating = False
Set ws1 = Sheets("Voids")
Set ws2 = Sheets("Tracking")
lastRow = ws2.Cells(Rows.Count, 2).End(xlUp).Row
arr1 = ws1.Range(ws1.Cells(4, 1), ws1.Cells(Rows.Count, 1).End(xlUp)).Value
arr2 = ws2.Range(ws2.Cells(1, 2), ws2.Cells(lastRow, 4)).Value

For i = LBound(arr1) To UBound(arr1)
    For j = LBound(arr2, 1) To UBound(arr2, 1)
        If arr1(i, 1) = arr2(j, 1) Then
            arr2(j, 3) = "Voided"
            Exit For
        End If
    Next j
Next i
ws2.Range(ws2.Cells(1, 2), ws2.Cells(lastRow, 4)).Value = arr2
Application.ScreenUpdating = True
MsgBox "The dishes are done, dude!"
End Sub

Cheers,

tonyyy

 

[KB_02]

That works PERFECTLY! Thank you!

And I am totally tempted to keep that exact message in the message box, too!

 

[tonyyy]

You're very welcome...

 

[KB_02]

Hello,
So the code is still working great, even though I have been playing with it. The higher ups wanted to see a bit more functionality added to to it and it was relatively easy to do (Once I break the code down, I can pretty much follow what is going on). but now I have had a request that I can't quite figure out (again). It has been requested that we track the voided items even if they were not sold out of the new system. AND, if there happens to be a duplicate entry, they would like that to show up, too (instead of a simple overwrite of existing data).

I tried adding in an "Else" statement for the items not on the tracking sheet, but it failed miserably. Here is what I currently have:

Sub ArrayLoop_1069822()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim arr1 As Variant, arr2 As Variant
Dim lastRow As Long, i As Long, j As Long

Application.ScreenUpdating = False
Set ws1 = Sheets("Voids")
Set ws2 = Sheets("Tracking")
        If ws1.Range("A5") = "" Then
           ws1.Range("A5").Value = "Blank"
        End If
lastRow = ws2.Cells(Rows.Count, 2).End(xlUp).Row
arr1 = ws1.Range(ws1.Cells(4, 1), ws1.Cells(Rows.Count, 4).End(xlUp)).Value
arr2 = ws2.Range(ws2.Cells(1, 2), ws2.Cells(lastRow, 9)).Value

    For i = LBound(arr1) To UBound(arr1)
    For j = LBound(arr2, 1) To UBound(arr2, 1)
        If arr1(i, 1) = arr2(j, 1) Then
            arr2(j, 3) = "Voided"
            arr2(j, 4) = arr1(i, 2)
            arr2(j, 5) = arr1(i, 3)
            arr2(j, 6) = arr1(i, 4)
            arr2(j, 7) = "Voided"
            arr2(j, 8) = Date
            Exit For
        End If
    Next j
Next i
ws2.Range(ws2.Cells(1, 2), ws2.Cells(lastRow, 9)).Value = arr2
Application.ScreenUpdating = True
MsgBox "All items marked as 'Voided' in Sheet Tracking."

ws1.Range("A4:D100").ClearContents
Range("A4").Select

End Sub

(totally got shot down on the original message box message. )

Can I add an "AND" clause to the "IF" statement so that it looks for the serial number AND ONLY if the corresponding boxes are empty, would it complete the process above? Then all other results would be added as a NEW entry to the tracking sheet?

 

[KB_02]

Forgot to mention that I added a quick "IF" statement if there was only one entry on the voids sheet. If there was only one entry, the code broke down.

 

[KB_02]

I have figure out the basic steps to get what I want using an ElseIf clause, but I run into the problem of the range being static and not dynamic.
If I leave LastRow defined as it is, any NEW entry will overwrite the last line. And any subsequent entry will overwrite that line. I can add in a "+1" to the definition of the LastRow, but it will never move beyond that.

This is an abbreviated version of what I have tried:

lastRow = ws2.Cells(Rows.Count, 2).End(xlUp).Row [COLOR=#ff0000]+ 1[/COLOR]
arr1 = ws1.Range(ws1.Cells(4, 1), ws1.Cells(Rows.Count, 4).End(xlUp)).Value
arr2 = ws2.Range(ws2.Cells(1, 2), ws2.Cells(lastRow, 9)).Value

    For i = LBound(arr1) To UBound(arr1)
    For j = LBound(arr2, 1) To UBound(arr2, 1)
        If arr1(i, 1) = arr2(j, 1) Then
            arr2(j, 3) = "Voided"
            arr2(j, 4) = arr1(i, 2)
            arr2(j, 5) = arr1(i, 3)
            arr2(j, 6) = arr1(i, 4)
            arr2(j, 7) = "Voided"
            arr2(j, 8) = Date
[COLOR=#b22222]        Elseif arr1(i, 1) <> arr2(j, 1) then
            arr2(j, 1) = arr1(1, 1)[/COLOR]
                [COLOR=#b22222]etc., etc....[/COLOR]
            Exit For
        End If
    Next j
Next i
ws2.Range(ws2.Cells(1, 2), ws2.Cells(lastRow, 9)).Value = arr2

Doing this only overwrites one line again and again if there are multiple entries. How do I make the range dynamic so it increases with each new entry?

 

[tonyyy]

Sub ArrayLoop_1069822()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim arr1 As Variant, arr2() As Variant
Dim lastRow As Long, i As Long, j As Long, addRow As Long
Dim tf As Boolean

Application.ScreenUpdating = False
Set ws1 = Sheets("Voids")
Set ws2 = Sheets("Tracking")
lastRow = ws2.Cells(Rows.Count, 2).End(xlUp).Row
addRow = lastRow
arr1 = ws1.Range(ws1.Cells(4, 1), ws1.Cells(Rows.Count, 1).End(xlUp)).Value
arr2 = ws2.Range(ws2.Cells(1, 2), ws2.Cells(lastRow, 4)).Value

For i = LBound(arr1) To UBound(arr1)
    tf = False
    For j = LBound(arr2, 1) To UBound(arr2, 1)
        If arr1(i, 1) = arr2(j, 1) Then
            arr2(j, 3) = "Voided"
            tf = True
        End If
    Next j
    If tf = False Then
        addRow = addRow + 1
        ws2.Cells(addRow, 2) = arr1(i, 1)
        ws2.Cells(addRow, 4) = "Voided"
    End If
Next i
ws2.Range(ws2.Cells(1, 2), ws2.Cells(lastRow, 4)).Value = arr2
Application.ScreenUpdating = True
MsgBox "The dishes are done, dude!"
End Sub

Don't think the ElseIf will work in this situation so introduced a tf (True/False) variable as a Boolean. If a match isn't found then addRow is incremented by one and the data is placed directly into the cells rather than arr2.

Ideally you'd like to do all this in arr2, but changing the size of an array after it's been initialized requires a Redim Preserve statement, and only the last dimension can be resized (and of course, we want the first dimension to be resized.) We could rewrite/transpose arr2 to swap dimensions but that's a pain (for me anyway - maybe someone else knows an easy way), so instead I chose to simply place the new data directly into the cells.

(Couldn't get your code to work properly on my dataset so I just modified the original code.)

 

[KB_02]

Once again, Sir, you are a Scholar and a gentleman.
Took me a minute to get it adapted in, but once I did, it works like a charm!

Thank you!