Run Dictionary Script & Find based on multiple criteria

[Lil Stinker]

@DanteAmor Hello again!

Since I only understand basic VBA, I need help figuring out how to update my Inventory sheet with returns based on a few different criteria. Here is the code you provided for locating and updating the serial numbers in inventory when items were going out.

Sub out_serial_number()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant
  Dim dic As Object, rng As Range
  Dim i&, j&, wRow&
  Dim dt As Date, lo As String, cad As String
  Dim f As Range
  
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  Set dic = CreateObject("Scripting.Dictionary")
  If sh1.AutoFilterMode Then sh1.AutoFilterMode = False
  If sh2.AutoFilterMode Then sh2.AutoFilterMode = False
  sh1.Cells.EntireRow.Hidden = False
  sh2.Cells.EntireRow.Hidden = False
  
  Set f = sh1.Range("B:B").Find("SERIAL NUMBERS", , xlValues, xlWhole, xlByRows, xlPrevious, False)
  a = sh1.Range("B11:O" & f.Row - 1).Value
  b = sh2.Range("B2:B" & sh2.Range("B" & Rows.Count).End(3).Row).Value
  c = sh2.Range("E2:G" & sh2.Range("B" & Rows.Count).End(3).Row).Value
  Set rng = sh2.Range("F1")
  
  dt = sh1.Range("A1").Value
  lo = sh1.Range("H1").Value
  
  For i = 1 To UBound(b, 1)
    dic(b(i, 1)) = i
  Next
  
  For i = 1 To UBound(a, 1)
    For j = 1 To UBound(a, 2)
      If a(i, j) <> "" Then
        If dic.exists(a(i, j)) Then
          wRow = dic(a(i, j))
          c(wRow, 1) = "Out"
          c(wRow, 2) = lo
          c(wRow, 3) = dt
          Set rng = Union(rng, sh2.Range("F" & wRow + 1))
        Else
          cad = cad & a(i, j) & vbCr
        End If
      End If
    Next
  Next
  
  sh2.Range("E2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
  rng.Font.Bold = True
  sh2.Range("F1").Font.Bold = False
  If cad <> "" Then
    MsgBox cad, , "Serial number was not found in inventory"
  End If
End Sub

Now, however, I need to mark the items "IN" but the process is a bit different. Not only does it need to find the matching serial number on the Inventory sheet, but it also needs to match the status based on the codes entered into a corresponding range on Sheet1. Based on my post from yesterday, Populate range based on match found between Userform & another range, I need to find the matching serial number and if the corresponding code range has a "Y", mark it "IN" on the Inventory sheet. If it has an "R", mark it as "DMG" on Inventory and for all entries, include the date of return on the Inventory sheet (or Sheet2).

It should look something like this:

Book1.xlsm
	A	B	C	D	E	F	G	H																		Z	AA	AB	AC	AD	AE	AF	AG
1	2/3/2023	Date Out		2/13/2023	Date In		Location	OC Carnival Event
2		SERIAL NUMBERS			Apples																						Serial Codes
3		011	4016	4264	4476	4716	4945	5106																			Y	R			G	Y	Y
4		016	4017	4275	4480	4717	4948	5107																			RD	y			R		Y
Sheet1

Book1.xlsm
	A	B	C	D	E	F	G	H
1	Item ID	SerialNumber	Item	Description	Status	Location	DateOut	ReturnDate
2	1	011	Apples	Red Delicious	IN	Warehouse		2/13/2023
3	2	016	Apples	Granny Smith	DMG	Repair		2/6/2023
4	3	4016	Apples	Granny Smith	DMG	Repair		2/13/2023
5	4	4264	Apples	Red Delicious	OUT	OC Carnival Event	2/3/2023
6	5	4476	Oranges	Naval	OUT	OC Carnival Event	2/3/2023
7	6	4945	Apples	Granny Smith	IN	Warehouse		2/13/2023
8	7	5106	Pears	Bosch	IN	Warehouse		2/13/2023
9	8	4716	Pears	Bosch	IN	Warehouse		2/6/2023
10	9	4017	Oranges	Naval	IN	Warehouse		2/13/2023
Inventory

 

[DanteAmor]

Assumptions:
1. As I recall, the serial numbers started on row 11 from B to O.
But you can adjust it in this line:
a = sh1.Range("B11:AN" & f.Row - 1).Value 'Fit the starting row number of the serial numbers

2. It also adjusts the date and location:
dt_in = sh1.Range("D9").Value 'Fit the cell of the date in
lo = sh1.Range("H9").Value 'Fit the cell of the location

3. I also remember that you had the text "SERIAL NUMBERS" at the end of the data in column B.

4. If it doesn't have "Y" and it doesn't have "R" then the status will be empty.

5. Now you will have 2 macros one macro for OUT and now this macro for IN.

Sub IN_serial_number()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant
  Dim dic As Object, rng As Range
  Dim i&, j&, wRow&
  Dim dt_in As Date, lo As String, cad As String, sCod As String
  Dim f As Range
  
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Inventory")
  Set dic = CreateObject("Scripting.Dictionary")
  If sh1.AutoFilterMode Then sh1.AutoFilterMode = False
  If sh2.AutoFilterMode Then sh2.AutoFilterMode = False
  sh1.Cells.EntireRow.Hidden = False
  sh2.Cells.EntireRow.Hidden = False
  
  Set f = sh1.Range("B:B").Find("SERIAL NUMBERS", , xlValues, xlWhole, xlByRows, xlPrevious, False)
  
  a = sh1.Range("B11:AN" & f.Row - 1).Value    'Fit the starting row number of the serial numbers
  dt_in = sh1.Range("D9").Value               'Fit the cell of the date in
  lo = sh1.Range("H9").Value                  'Fit the cell of the location
  
  b = sh2.Range("B2:B" & sh2.Range("B" & Rows.Count).End(3).Row).Value
  c = sh2.Range("E2:H" & sh2.Range("B" & Rows.Count).End(3).Row).Value
  Set rng = sh2.Range("F1")
  For i = 1 To UBound(b, 1)
    dic(b(i, 1)) = i
  Next
  
  For i = 1 To UBound(a, 1)
    For j = 1 To 14             'from column B to column O
      If a(i, j) <> "" Then
        If dic.exists(a(i, j)) Then
          wRow = dic(a(i, j))
          sCod = ""
          Select Case a(i, j + 25)
            Case "Y": sCod = "IN"
            Case "R": sCod = "DMG"
          End Select
          c(wRow, 1) = sCod
          c(wRow, 2) = lo
          c(wRow, 4) = dt_in
          Set rng = Union(rng, sh2.Range("F" & wRow + 1))
        Else
          cad = cad & a(i, j) & vbCr
        End If
      End If
    Next
  Next
  
  sh2.Range("E2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
  rng.Font.Bold = True
  sh2.Range("F1").Font.Bold = False
  If cad <> "" Then
    MsgBox cad, , "Serial number was not found in inventory"
  End If
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​

 

[Lil Stinker]

I'm getting inconsistent results with this on both my test workbook and actual workbook. Honestly, I'm completely baffled. Now it seems that neither the original working code for marking items Out is running correctly in my test workbook either. It appears to only recognize serial numbers starting with zero or letters in them when running the Out code. The cad msgbox comes up "not finding" every serial number that is just a number with no starting zero or letter. As a result, it only marks the found numbers Out on the Inventory sheet.

When running the In code, the results are inconsistent. It seems to find all of the serial numbers despite the cad msgbox coming up with the identical numbers not found. However, only one number was marked DMG even though I have a few marked "R" which should signify DMG. And only a handful of results populated with the Return Date.

I've tried changing the formatting on both sheets to General and Text but the results are the same. Perhaps my initial test sample didn't include serial numbers with letters and starting zeros? I've posted a new sample below to demonstrate the modified ranges in the code.

I did make some minor modifications to both macros but, as I mentioned in the previous post, the Out macro was working just fine even with my modifications. Please tell me if I screwed something up.
Out:

  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant
  Dim dic As Object, rng As Range, f As Range
  Dim i&, j&, wRow&
  Dim dt As Date, dtN As Date, lo As String, cad As String
  Dim count As Long, benchmark As Double
  
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Inventory")
  Set dic = CreateObject("Scripting.Dictionary")
'    If sh2.AutoFilterMode Then sh2.AutoFilterMode = False  <--turned off auto filter altogether so no longer needed
'  sh1.Cells.EntireRow.Hidden = False
  Set f = sh1.Range("B:B").Find("SERIAL NUMBERS", , xlValues, xlWhole, xlByRows, xlPrevious, False)
  a = sh1.Range("B3:S" & f.Row - 1).Value
  b = sh2.Range("B2:B" & sh2.Range("B" & Rows.count).End(3).Row).Value
  c = sh2.Range("E2:H" & sh2.Range("B" & Rows.count).End(3).Row).Value
  Set rng = sh2.Range("F1")
  
  dt = sh1.Range("A1").Value
  lo = sh1.Range("H1").Value
  
  For i = 1 To UBound(b, 1)
    dic(b(i, 1)) = i
  Next
  
  For i = 1 To UBound(a, 1)
    For j = 1 To UBound(a, 2)
      If a(i, j) <> "" Then
        If dic.exists(a(i, j)) Then
          wRow = dic(a(i, j))
          c(wRow, 1) = "OUT"
          c(wRow, 2) = lo
          c(wRow, 3) = dt
          Set rng = Union(rng, sh2.Range("F" & wRow + 1))
        Else
          cad = cad & a(i, j) & vbCr
        End If
      End If
    Next
  Next
  
  sh2.Range("E2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
  rng.Font.Bold = True
  sh2.Range("F1").Font.Bold = False
  If cad <> "" Then
    MsgBox cad, , "Serial number not found in inventory"
  End If

End Sub

In:

Sub IN_serial_number2()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant
  Dim dic As Object, rng As Range
  Dim i&, j&, wRow&
  Dim dt_in As Date, lo As String, cad As String, sCod As String
  Dim f As Range
  
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Inventory")
  Set dic = CreateObject("Scripting.Dictionary")
  
  Set f = sh1.Range("B:B").Find("SERIAL NUMBERS", , xlValues, xlWhole, xlByRows, xlPrevious, False)
  
  a = sh1.Range("B3:AR" & f.Row - 1).Value    'Fit the starting row number of the serial numbers
  dt_in = sh1.Range("D1").Value               'Fit the cell of the date in
  lo = "Warehouse"                  'Fit the cell of the location
  b = sh2.Range("B2:B" & sh2.Range("B" & Rows.count).End(3).Row).Value
  c = sh2.Range("E2:H" & sh2.Range("B" & Rows.count).End(3).Row).Value
  Set rng = sh2.Range("F1")
  For i = 1 To UBound(b, 1)
    dic(b(i, 1)) = i
  Next
  
  For i = 1 To UBound(a, 1)
    For j = 1 To 18             'from column B to column S
      If a(i, j) <> "" Then
        If dic.exists(a(i, j)) Then
          wRow = dic(a(i, j))
          sCod = ""
          Select Case a(i, j + 25)
            Case "Y": sCod = "IN"
            Case "R": sCod = "DMG"
          End Select
          c(wRow, 1) = sCod
          c(wRow, 2) = lo
          c(wRow, 3) = ""   '<--added to clear date out field
          c(wRow, 4) = dt_in
          Set rng = Union(rng, sh2.Range("F" & wRow + 1))
        Else
          cad = cad & a(i, j) & vbCr
        End If
      End If
    Next
  Next
  
  sh2.Range("E2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
  rng.Font.Bold = False
  sh2.Range("F1").Font.Bold = True
  If cad <> "" Then
    MsgBox cad, , "Serial number was not found in inventory"
  End If
End Sub

Book1.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T						Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP	AQ	AR
1	2/3/2023	Date Out		2/13/2023	Date In		Location	OC Carnival Event
2		SERIAL NUMBERS			Apples											Oranges		Pears									Serial Codes
3		011	4016	4264	4476	4716	4945	5106	5318	5537	5727	5943	6407	6548	6721	MB006	9569	MB211	A322								Y	R			G	Y	Y	Y	R	R	G	G	Y	Y		Y	Y	R
4		016	4017	4275	4480	4717	4948	5107	5320	5540	5731	5945	6408	6553	6722	MB007	9570	MB212	A348								RD	y			R		Y	Y			Y	R			Y		Y
5
6
7
8
9		SERIAL NUMBERS			Apples											Oranges		Pears
Sheet1

4. If it doesn't have "Y" and it doesn't have "R" then the status will be empty.

Apologies, I neglected to mention in the Serial Code section, if the cell is blank or has "G" or "RD", nothing should change on the Inventory sheet as it refers to either the item not coming in yet or was returned previously in either a "Y" or "R" state.

Other notes, I turned off the AutoFilter on the Inventory sheet manually so it doesn't need to be part of the macro. And I added in [ c(wRow, 3) = "" ] to clear the Date Out field if the number is being marked IN.

 

[DanteAmor]

Try the following:

Sub OUT_serial_number2()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant
  Dim dic As Object, rng As Range, f As Range
  Dim i&, j&, wRow&
  Dim dt As Date, lo As String, cad As String, snum As String
 
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Inventory")
  Set dic = CreateObject("Scripting.Dictionary")
  Set f = sh1.Range("B:B").Find("SERIAL NUMBERS", , xlValues, xlWhole, xlByRows, xlPrevious, False)
  a = sh1.Range("B3:S" & f.Row - 1).Value
  b = sh2.Range("B2:B" & sh2.Range("B" & Rows.count).End(3).Row).Value
  c = sh2.Range("E2:H" & sh2.Range("B" & Rows.count).End(3).Row).Value
  Set rng = sh2.Range("F1")
 
  dt = sh1.Range("A1").Value
  lo = sh1.Range("H1").Value
 
  For i = 1 To UBound(b, 1)
    dic(Format(b(i, 1), "@")) = i
  Next
 
  For i = 1 To UBound(a, 1)
    For j = 1 To UBound(a, 2)
      If a(i, j) <> "" Then
        snum = Format(a(i, j), "@")
        If dic.exists(snum) Then
          wRow = dic(snum)
          c(wRow, 1) = "OUT"
          c(wRow, 2) = lo
          c(wRow, 3) = dt
          Set rng = Union(rng, sh2.Range("F" & wRow + 1))
        Else
          cad = cad & a(i, j) & vbCr
        End If
      End If
    Next
  Next
 
  sh2.Range("E2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
  rng.Font.Bold = True
  sh2.Range("F1").Font.Bold = False
  If cad <> "" Then
    MsgBox cad, , "Serial number not found in inventory"
  End If
End Sub

------------------​

Sub IN_serial_number2()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant
  Dim dic As Object, rng As Range, f As Range
  Dim i&, j&, wRow&
  Dim dt_in As Date, lo As String, cad As String, sCod As String, snum As String
 
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Inventory")
  Set dic = CreateObject("Scripting.Dictionary")
 
  Set f = sh1.Range("B:B").Find("SERIAL NUMBERS", , xlValues, xlWhole, xlByRows, xlPrevious, False)
 
  a = sh1.Range("B3:AR" & f.Row - 1).Value    'Fit the starting row number of the serial numbers
  dt_in = sh1.Range("D1").Value               'Fit the cell of the date in
  lo = "Warehouse"                  'Fit the cell of the location
  b = sh2.Range("B2:B" & sh2.Range("B" & Rows.count).End(3).Row).Value
  c = sh2.Range("E2:H" & sh2.Range("B" & Rows.count).End(3).Row).Value
  Set rng = sh2.Range("F1")
  For i = 1 To UBound(b, 1)
    dic(Format(b(i, 1), "@")) = i
  Next
 
  For i = 1 To UBound(a, 1)
    For j = 1 To 18             'from column B to column S
      If a(i, j) <> "" Then
        snum = Format(a(i, j), "@")
        If dic.exists(snum) Then
          wRow = dic(snum)
          sCod = ""
          Select Case a(i, j + 25)
            Case "Y": sCod = "IN"
            Case "R": sCod = "DMG"
          End Select
          If sCod <> "" Then
            c(wRow, 1) = sCod
            c(wRow, 2) = lo
            c(wRow, 3) = ""   '<--added to clear date out field
            c(wRow, 4) = dt_in
            Set rng = Union(rng, sh2.Range("F" & wRow + 1))
          End If
        Else
          cad = cad & a(i, j) & vbCr
        End If
      End If
    Next
  Next
 
  sh2.Range("E2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
  rng.Font.Bold = False
  sh2.Range("F1").Font.Bold = True
  If cad <> "" Then
    MsgBox cad, , "Serial number was not found in inventory"
  End If
End Sub

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------​

"Patience is bitter, but its fruit is sweet"
"La paciencia es amarga, pero sus frutos son dulces"
"La patience est amère, mais son fruit est doux"
- Jean Jacques Rousseau -​

 

[Lil Stinker]

So I think we're solid on the OUT macro. It ran great both on the test and actual workbook, no issues. As for the IN macro, it runs great on the test but nothing is happening in the actual book. The Inventory worksheet is not getting updated at all.

Can you tell me what the 25 in this line represents?

Select Case a(i, j + 25)

If it's a column count or something spacial, it could be where the issue stems from. My actual workbook has 25 columns with helper information in between the Serial Number range and the Serial Code range whereas the test book only had a few blank columns in between. Other than that, I can't think of what else would be causing the problem. I'm not getting any errors, just no results.

Thank you again

 

[DanteAmor]

Assumptions:

Could you put the real example, that is, your real file, so I wouldn't have to be assuming things.

Share your file. In the file you tell me with which values you have problems.
You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

---------------------​

Can you tell me what the 25 in this line represents?

 

[Lil Stinker]

I can't share the workbook because it's proprietary. However, now that I know what that 25 was referring to, I was able to make the correction and now it is running perfectly! It was all my fault from the start, I had forgotten about some of the columns in the actual workbook because they were hidden. Otherwise, my test book was nearly exact. Apologies for the inconvenience but we are good now.

One last question, since Dictionary stores the values in memory each time it is run, does it increase the file size? I just noticed my file size increased to over a MB since last week without adding any significant elements. Just wondering if this would be a part of the reason.

 

[DanteAmor]

since Dictionary stores the values in memory each time it is run, does it increase the file size?

No.

Check if you have unused cells in your sheet, that is, maybe cells with blank spaces.
Press Control + End to go to the bottom of the sheet, delete the rows and columns that appear to have no data.