VBA extreme newbie limping through code, vlookup issues

obeykube

New Member
Joined
Jan 26, 2023
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Hello all.

I am a manufacturing engineer and we have a program that tracks our inventory levels but does not generate a report that gives us changes each day, but can dump the data into an excel file. I have limped all day online and have made a pretty rough and probably embarrassing code that does the following.

1. Opens up a worksheet from inventory program with todays date, copys it to the active worksheet
2. Opens up a worksheet from inventory program with a user specified date, copys it to the active worksheet
3.Renames those sheets as Todays Date. Specified Date, and makes a new sheet called Comparison
4. Brings in the Part numbers from Todays date into the comparison sheet column A (reason I am doing it this way is if new parts come into stock the two sheets may not match, so I thought taking todays inventory part numbers and comparing it to previous with vlookup would avoid errors)
5. Finds the size of the part number column (basically how many entries there is)
6.Runs a loop that looks at the comparison part number, finds the inventory value from both the todays date and specified date sheet, subtracts them, and adds them to the comparison sheet
7.Loop until you are done.

I understand this code is probably so inefficient it'll make your headspin, but today is the first day I am writing VBA code in my life. I used matlab before so I can limp by, but for some reason, vlookup keeps giving me 1004 error code. I tried on the sheet itself and the logic I am using works.

Any help is appreciated. I can't post the data set as it's protected by every law under the sun, with security clearance thrown in there for good measure :)

Thanks,
Ryan


Sub RunCompare()

Dim sh As Integer, ShName As String
Dim wbPrev As Workbook
Dim wbCur As Workbook
Dim wsPrev As Sheets
Dim wsCur As Sheets
Dim iRow As Double, iCol As Double, iRow_Max As Double, iCol_Max As Double
Dim File1_Path As String, File2_Path As String, F1_Data As String, F2_Data As String
Dim SourceLastRow As Integer
Dim i As Integer
Dim ILB As String
Dim ILA As String

'Assign the Workbook File Name along with its Path
Dim DateFrom As Double
DateFrom = Worksheets("Compare Date").Range("B2").Value
File1_Path = "C:\Users\rkubik\Desktop\TEST" & "\" & Format(Date, "ddmmyyyy")
File2_Path = "C:\Users\rkubik\Desktop\TEST" & "\" & DateFrom

Application.ScreenUpdating = False

Set wbPrev = Workbooks.Open(File2_Path)
wbPrev.Sheets("Sheet1").Copy Before:=ThisWorkbook.Sheets("Comparison")
Worksheets("Sheet1").Name = "SpecifiedDate"
wbPrev.Close SaveChanges:=False
Set wbCur = Workbooks.Open(File1_Path)
wbCur.Sheets("Sheet1").Copy Before:=ThisWorkbook.Sheets("Comparison")
wbCur.Close SaveChanges:=False
Worksheets("Sheet1").Name = "TodaysDate"
Worksheets("Todaysdate").Range("A3:A739").Copy Worksheets("Comparison").Range("A1")

With Worksheets("Comparison")
SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).row
End With
i = 1
Do While i <= SourceLastRow
On Error Resume Next
ILB = Application.WorksheetFunction.VLookup(("A" & i), Worksheets("SpecifiedDate").Range("A3: D" & SourceLastRow + 3), 4, 0)
On Error GoTo 0
ILA = Application.WorksheetFunction.VLookup(("A" & i), Worksheets("TodaysDate").Range("A3: D" & SourceLastRow + 3), 4, 0)
On Error GoTo 0
Range("B" & i).Value = ILA - ILB
Range("C" & i).Value = ILA
i = i + 1
Loop
End Sub
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
You have :

Dim ILB As String
Dim ILA As String

but also :
Range("B" & i).Value = ILA - ILB

Are these numeric or string type values?
 
Upvote 0
I agree with @Herakles that if ILB & ILA are numeric they should not be dimmed as String but as one of number formats eg double, long, integer etc.
It is not however what is breaking your code. VBA is doing the conversion of these on the fly.

Note: you were using the same last row for 3 sheets which doesn't make sense.

Rich (BB code):
Sub RunCompare()

Dim sh As Integer, ShName As String
Dim wbPrev As Workbook
Dim wbCur As Workbook
Dim wsPrev As Sheets
Dim wsCur As Sheets
Dim iRow As Double, iCol As Double, iRow_Max As Double, iCol_Max As Double
Dim File1_Path As String, File2_Path As String, F1_Data As String, F2_Data As String
Dim SourceLastRow As Integer
Dim i As Integer
Dim ILB As String
Dim ILA As String

'Assign the Workbook File Name along with its Path
Dim DateFrom As Double
DateFrom = Worksheets("Compare Date").Range("B2").Value
File1_Path = "C:\Users\rkubik\Desktop\TEST" & "\" & Format(Date, "ddmmyyyy")
File2_Path = "C:\Users\rkubik\Desktop\TEST" & "\" & DateFrom

Application.ScreenUpdating = False

Set wbPrev = Workbooks.Open(File2_Path)
wbPrev.Sheets("Sheet1").Copy Before:=ThisWorkbook.Sheets("Comparison")
Worksheets("Sheet1").Name = "SpecifiedDate"
wbPrev.Close SaveChanges:=False
Set wbCur = Workbooks.Open(File1_Path)
wbCur.Sheets("Sheet1").Copy Before:=ThisWorkbook.Sheets("Comparison")
wbCur.Close SaveChanges:=False
Worksheets("Sheet1").Name = "TodaysDate"
Worksheets("Todaysdate").Range("A3:A739").Copy Worksheets("Comparison").Range("A1")

' ---- Changed from here down ----
Dim shtComp As Worksheet, shtSpec As Worksheet, shtToday As Worksheet
Dim specLastRow As Long, todayLastRow As Long

Set shtSpec = Worksheets("SpecifiedDate")
Set shtToday = Worksheets("TodaysDate")
specLastRow = shtSpec.Cells(shtSpec.Rows.Count, "A").End(xlUp).Row
todayLastRow = shtToday.Cells(shtToday.Rows.Count, "A").End(xlUp).Row

With Worksheets("Comparison")
    SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    i = 1
    Do While i <= SourceLastRow
        On Error Resume Next
        ILB = Application.WorksheetFunction.VLookup(.Range("A" & i), shtSpec.Range("A3: D" & specLastRow + 3), 4, 0)
        ILA = Application.WorksheetFunction.VLookup(.Range("A" & i), shtToday.Range("A3: D" & todayLastRow + 3), 4, 0)
        On Error GoTo 0
        .Range("B" & i).Value = ILA - ILB
        .Range("C" & i).Value = ILA
        i = i + 1
    Loop
End With
End Sub
 
Last edited:
Upvote 0
Hi and welcome to MrExcel Forum!

The error is because the data is not found.
vlookup keeps giving me 1004 error code

I recommend you to use the Find method, in case of error the object set in the Find method is empty.

I made some adjustments in the code, try it and comment the result.
VBA Code:
Sub RunCompare()
  Dim shC As Worksheet, shS As Worksheet, shT As Worksheet
  Dim wb As Workbook
  Dim i As Long
  Dim f As Range
  Dim DateFrom As Double
  Dim File1_Path As String, File2_Path As String
  Dim ILB As Variant, ILA As Variant
  
  'Assign the Workbook File Name along with its Path
  DateFrom = Worksheets("Compare Date").Range("B2").Value
  File1_Path = "C:\Users\rkubik\Desktop\TEST" & "\" & Format(Date, "ddmmyyyy")
  File2_Path = "C:\Users\rkubik\Desktop\TEST" & "\" & DateFrom
  
  Application.ScreenUpdating = False
  Set shC = Sheets("Comparison")
  
  Set wb = Workbooks.Open(File2_Path)
  wb.Sheets("Sheet1").copy Before:=shC
  wb.Close SaveChanges:=False
  Sheets("Sheet1").Name = "SpecifiedDate"
  
  Set wb = Workbooks.Open(File1_Path)
  wb.Sheets("Sheet1").copy Before:=shC
  wb.Close SaveChanges:=False
  Sheets("Sheet1").Name = "TodaysDate"
  
  Set shS = Sheets("SpecifiedDate")
  Set shT = Sheets("TodaysDate")
  
  shS.Range("A3:A" & Rows.Count).copy shC.Range("A1")
  
  For i = 1 To shC.Range("A" & Rows.Count).End(3).Row
    ILB = 0
    ILA = 0
    Set f = shS.Range("A:A").Find(shC.Range("A" & i).Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then ILB = shS.Range("D" & f.Row).Value
    Set f = shT.Range("A:A").Find(shC.Range("A" & i).Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then ILA = shT.Range("D" & f.Row).Value
    
    shC.Range("B" & i).Value = ILA - ILB
    shC.Range("C" & i).Value = ILA
  Next
  
  Application.ScreenUpdating = False
  shC.Select
End Sub
 
Upvote 0
Change these lines
VBA Code:
ILB = Application.WorksheetFunction.VLookup(("A" & i), Worksheets("SpecifiedDate").Range("A3: D" & SourceLastRow + 3), 4, 0)
On Error GoTo 0
ILA = Application.WorksheetFunction.VLookup(("A" & i), Worksheets("TodaysDate").Range("A3: D" & SourceLastRow + 3), 4, 0)
as
VBA Code:
ILB = Application.WorksheetFunction.VLookup(Range("A" & i), Worksheets("SpecifiedDate").Range("A3: D" & SourceLastRow + 3), 4, 0)
On Error GoTo 0
ILA = Application.WorksheetFunction.VLookup(Range("A" & i), Worksheets("TodaysDate").Range("A3: D" & SourceLastRow + 3), 4, 0)
 
Upvote 0
Solution
AH this makes sense. Thank you guys. This is fun once things work lol.
 
Upvote 0
You have other details in your code that I corrected in my post, for example,

Set wbPrev = Workbooks.Open(File2_Path)
wbPrev.Sheets("Sheet1").Copy Before:=ThisWorkbook.Sheets("Comparison")

'in this line you are changing the sheet name, but you are changing the sheet name, in the File2_Path workbook, you have to close the workbook first, that way you can change the sheet name in the active workbook (thisworkbook)
Worksheets("Sheet1").Name = "SpecifiedDate"
wbPrev.Close SaveChanges:=False

In the second part of code the name change is correct:
Set wbCur = Workbooks.Open(File1_Path)
wbCur.Sheets("Sheet1").Copy Before:=ThisWorkbook.Sheets("Comparison")
wbCur.Close SaveChanges:=False
Worksheets("Sheet1").Name = "TodaysDate"
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top