Help! IF/Then Vlookup with offset?

J

jmthompson

Well-known Member
Joined
Mar 31, 2008
Messages
966
To begin, I did have another thread looking for a solution, but I don't think the subject was descriptive enough- see original thread here- http://www.mrexcel.com/forum/showthread.php?t=325282


I have tried this code a number of ways, and no matter what I try, I get run-time 1004 application-defined or object-defined error.
Here is my code:

Code: 
Sub DropShip()
MyDate = DateSerial(Year(Date), Month(Date) - 1, 1)
MyMonth = Format(MyDate, "mmmm")
MyYear = Year(MyDate)
MyPath = "C:\Documents and Settings\JThomps2\Desktop\WorkflowOne\Billing\" & MyYear & "\" & MyMonth & "\Drop Ship\"
MyFile = MyMonth & " " & MyYear & ".xls"
MyPDFile = "TPD " & MyMonth & " " & MyYear & ".xls"
Sheets(MyMonth & " " & MyYear).Select
    Dim c As Range
 
        For Each c In Range([B50], Cells(Rows.Count, "B").End(xlUp))
            If c = "12100 - The Grand Rapids Press" Then c.Offset(0, 4).FormulaR1C1 = "=VLookup(" & c.Offset(0, 1).Address & ", '[C:\Documents and Settings\JThomps2\Desktop\WorkflowOne\Billing\2008\May\Drop Ship\May 2008.xls]Grand Rapids'!(B5:D23), 3, False)"

Next c
End Sub

error here:
Code: 
Then c.Offset(0, 4).FormulaR1C1 = "=VLookup(" & c.Offset(0, 1).Address & ", '[C:\Documents and Settings\JThomps2\Desktop\WorkflowOne\Billing\2008\May\Drop Ship\May 2008.xls]Grand Rapids'!(B5:D23), 3, False)"

In this iteration, I have entered the actual file name for the table array. I am at a loss. I don't know what is causing the error, is it the use of c.Offset? The syntax of the table array? Or something else entirely?

I would appreciate any suggestions!
 
Sort by date Sort by votes
I am humbled by your greatness
Click to expand...

I don't know about that. It only took us 20 posts to get it done....And There are probably a bunch of people reading this saying.."Holy Cow, that's some ugly sloppy code!!"

But thanks anyway. Glad to help..

Now just wait till you try to loop it through 26 possible values for C - 26 different sheets right ?

all that's going to change is the sheet name right?
Try a select case structure...
Code: 
Select Case C.Value
    Case "12100 - The Grand Rapids Press"
        MySTring = "Grand Rapids"
    Case "12100 - The Detroit Press"
        MyString = "Detroit"
    Case "12100 - "Whatever Blah Blah"
        MyString = "Whatever"
End Select

Then everywhere you use Sheets("Grand Rapids") in the code, change it to
Sheets(MyString)

And also in the vlookup formula, use the MyString Variable in place of Grand Rapids

Then you can remove the
If c = "12100 - The Grand Rapids Press" Then

end If

This way, you don't have to repeat the WHOLE code for each of the 26 sheets.
 
Upvote 0

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Wow, that would be a time saver!

I just tested this with only one variable and I am getting error 91 "Object variable with block variable not set"

Code: 
Sub DropShip()
MyDate = DateSerial(Year(Date), Month(Date) - 1, 1)
MyMonth = Format(MyDate, "mmmm")
MyYear = Year(MyDate)
MyPath = "C:\Documents and Settings\JThomps2\Desktop\WorkflowOne\Billing\" & MyYear & "\" & MyMonth & "\Drop Ship\"
MyFile = MyMonth & " " & MyYear & ".xls"
MyPDFile = "TPD " & MyMonth & " " & MyYear & ".xls"
MyMasterPath = "C:\Documents and Settings\JThomps2\Desktop\WorkflowOne\Billing\" & MyYear & "\"
MyMaster = "WFO Daily Postage Log" & MyYear & ".update.xls"
Dim c As Range
Dim X As Variant
Dim CurBook As Worksheet
Dim SrceBook As Workbook
Set CurBook = Workbooks("WFO Daily Postage Log" & MyYear & ".update.xls").Sheets(MyMonth & " " & MyYear)
Set SrceBook = Workbooks.Open(MyPath & MyFile)
Select Case c.Value
    Case "12000 - The Birmingham News"
        MyString = "Birmingham"
End Select
For Each c In CurBook.Range(CurBook.[B50], CurBook.Cells(Rows.Count, "B").End(xlUp))
        On Error Resume Next
        X = ""
        X = SrceBook.Sheets(MyString).Name
        On Error GoTo 0
        If X = "Birmingham" Then
            LR = SrceBook.Sheets(MyString).Cells(Rows.Count, "B").End(xlUp).Row
            X = Application.Match(c.Offset(0, 1).Value, SrceBook.Sheets(MyString).Range("B2:B" & LR), 0)
            If IsError(X) Then
                c.Offset(0, 4).ClearContents
            Else
                c.Offset(0, 4).Formula = "=VLookup(" & c.Offset(0, 1).Address & ", '" & MyPath & "[" & MyFile & "]MyString'!B5:D" & LR & ", 3, False)"
            End If
        Else
            c.Offset(0, 4).ClearContents
        End If
    
Next c
End Sub

This is the highlighted line of code:
Code: 
Select Case c.Value
 
Upvote 0
Figured it out, although, it appears that if a case doesn't exist for a value listed in B, it populates with data from another case.

Code: 
Sub DropShip()
MyDate = DateSerial(Year(Date), Month(Date) - 1, 1)
MyMonth = Format(MyDate, "mmmm")
MyYear = Year(MyDate)
MyPath = "C:\Documents and Settings\JThomps2\Desktop\WorkflowOne\Billing\" & MyYear & "\" & MyMonth & "\Drop Ship\"
MyFile = MyMonth & " " & MyYear & ".xls"
MyPDFile = "TPD " & MyMonth & " " & MyYear & ".xls"
MyMasterPath = "C:\Documents and Settings\JThomps2\Desktop\WorkflowOne\Billing\" & MyYear & "\"
MyMaster = "WFO Daily Postage Log" & MyYear & ".update.xls"
Dim c As Range
Dim X As Variant
Dim CurBook As Worksheet
Dim SrceBook As Workbook
Set CurBook = Workbooks("WFO Daily Postage Log" & MyYear & ".update.xls").Sheets(MyMonth & " " & MyYear)
Set SrceBook = Workbooks.Open(MyPath & MyFile)
For Each c In CurBook.Range(CurBook.[B50], CurBook.Cells(Rows.Count, "B").End(xlUp))
Select Case c.Value
    Case "12000 - The Birmingham News"
        MyString = "Birmingham"
    Case "12100 - The Grand Rapids Press"
        MyString = "Grand Rapids"
End Select
        On Error Resume Next
        X = ""
        X = SrceBook.Sheets(MyString).Name
        On Error GoTo 0
        If X = MyString Then
            LR = SrceBook.Sheets(MyString).Cells(Rows.Count, "B").End(xlUp).Row
            X = Application.Match(c.Offset(0, 1).Value, SrceBook.Sheets(MyString).Range("B2:B" & LR), 0)
            If IsError(X) Then
                c.Offset(0, 4).ClearContents
            Else
                c.Offset(0, 4).Formula = "=VLookup(" & c.Offset(0, 1).Address & ", '" & MyPath & "[" & MyFile & "]" & MyString & "'!B5:D" & LR & ", 3, False)"
            End If
        Else
            c.Offset(0, 4).ClearContents
        End If
    
Next c
End Sub
 
Upvote 0
Dang it!

I was working, but now that I've added the rest of my cases, I'm getting the subscript out of range error
Code: 
Sub DropShip()
MyDate = DateSerial(Year(Date), Month(Date) - 1, 1)
MyMonth = Format(MyDate, "mmmm")
MyYear = Year(MyDate)
MyPath = "C:\Documents and Settings\JThomps2\Desktop\WorkflowOne\Billing\" & MyYear & "\" & MyMonth & "\Drop Ship\"
MyFile = MyMonth & " " & MyYear & ".xls"
MyPDFile = "TPD " & MyMonth & " " & MyYear & ".xls"
MyMasterPath = "C:\Documents and Settings\JThomps2\Desktop\WorkflowOne\Billing\" & MyYear & "\"
MyMaster = "WFO Daily Postage Log" & MyYear & ".update.xls"
Dim c As Range
Dim X As Variant
Dim CurBook As Worksheet
Dim SrceBook As Workbook
Set CurBook = Workbooks("WFO Daily Postage Log" & MyYear & ".update.xls").Sheets(MyMonth & " " & MyYear)
Set SrceBook = Workbooks.Open(MyPath & MyFile)
For Each c In CurBook.Range(CurBook.[B50], CurBook.Cells(Rows.Count, "B").End(xlUp))
Select Case c.Value
    Case "12000 - The Birmingham News"
        MyString = "Birmingham"
    Case "12100 - The Grand Rapids Press"
        MyString = "Grand Rapids"
    Case "12200 - The Post-Standard"
        MyString = "Post Standard"
    Case "13100 - The Republican"
        MyString = "Republican"
    Case "13500 - The Huntsville Times"
        MyString = "Huntsville"
    Case "13600 - Kalamazoo Gazette"
        MyString = "Kalamazoo"
    Case "14600 - The Express-Times"
        MyString = "Express Times"
    Case "14800 - The Muskegon Chronicle"
        MyString = "Muskegon"
    Case "17100 - NJN Publishing"
        MyString = "N Jersey"
    Case "19130 - Valley Publishing"
        MyString = "BC-Sag"
        
End Select

        X = ""
        X = SrceBook.Sheets(MyString).Name
        On Error GoTo 0
        If X = MyString Then
            LR = SrceBook.Sheets(MyString).Cells(Rows.Count, "B").End(xlUp).Row
            X = Application.Match(c.Offset(0, 1).Value, SrceBook.Sheets(MyString).Range("B2:B" & LR), 0)
            If IsError(X) Then
                c.Offset(0, 4).ClearContents
            Else
                c.Offset(0, 4).Formula = "=VLookup(" & c.Offset(0, 1).Address & ", '" & MyPath & "[" & MyFile & "]" & MyString & "'!B5:D" & LR & ", 3, False)"
            End If
        Else
            c.Offset(0, 4).ClearContents
        End If
    
Next c
End Sub

Highlighted row
Code: 
X = SrceBook.Sheets(MyString).Name
 
Upvote 0
Subscript out of range means the thing (sheet or book) doesn't exist.

Check your spelling in both the code AND On the Actual Sheet Tab Names.
Look for extra spaces.

To narrow it down, at the time of the error, hover your mouse over MyString and that will tell you which sheet is having the problem..
 
Upvote 0
Here's an updated code, Try this

You had removed the On Error Resume Next, that was handling the Non Existent Sheets...

Code: 
Sub DropShip()
MyDate = DateSerial(Year(Date), Month(Date) - 1, 1)
MyMonth = Format(MyDate, "mmmm")
MyYear = Year(MyDate)
MyPath = "C:\Documents and Settings\JThomps2\Desktop\WorkflowOne\Billing\" & MyYear & "\" & MyMonth & "\Drop Ship\"
MyFile = MyMonth & " " & MyYear & ".xls"
MyPDFile = "TPD " & MyMonth & " " & MyYear & ".xls"
MyMasterPath = "C:\Documents and Settings\JThomps2\Desktop\WorkflowOne\Billing\" & MyYear & "\"
MyMaster = "WFO Daily Postage Log" & MyYear & ".update.xls"
Dim c As Range
Dim X As Variant
Dim CurBook As Worksheet
Dim SrceBook As Workbook
Set CurBook = Workbooks("WFO Daily Postage Log" & MyYear & ".update.xls").Sheets(MyMonth & " " & MyYear)
Set SrceBook = Workbooks.Open(MyPath & MyFile)
For Each c In CurBook.Range(CurBook.[B50], CurBook.Cells(Rows.Count, "B").End(xlUp))
Select Case c.Value
    Case "12000 - The Birmingham News"
        MyString = "Birmingham"
    Case "12100 - The Grand Rapids Press"
        MyString = "Grand Rapids"
    Case "12200 - The Post-Standard"
        MyString = "Post Standard"
    Case "13100 - The Republican"
        MyString = "Republican"
    Case "13500 - The Huntsville Times"
        MyString = "Huntsville"
    Case "13600 - Kalamazoo Gazette"
        MyString = "Kalamazoo"
    Case "14600 - The Express-Times"
        MyString = "Express Times"
    Case "14800 - The Muskegon Chronicle"
        MyString = "Muskegon"
    Case "17100 - NJN Publishing"
        MyString = "N Jersey"
    Case "19130 - Valley Publishing"
        MyString = "BC-Sag"
    Case Else
        MyString = ""
End Select
        X = ""
        On Error Resume Next
        X = SrceBook.Sheets(MyString).Name
        On Error GoTo 0
        If X = MyString Then
            LR = SrceBook.Sheets(MyString).Cells(Rows.Count, "B").End(xlUp).Row
            X = Application.Match(c.Offset(0, 1).Value, SrceBook.Sheets(MyString).Range("B2:B" & LR), 0)
            If IsError(X) Then
                c.Offset(0, 4).ClearContents
            Else
                c.Offset(0, 4).Formula = "=VLookup(" & c.Offset(0, 1).Address & ", '" & MyPath & "[" & MyFile & "]" & MyString & "'!B5:D" & LR & ", 3, False)"
            End If
        Else
            c.Offset(0, 4).ClearContents
        End If
    
Next c
End Sub
 
Upvote 0
Sorry, should have mentioned, I removed that intentionally after reciving the subscript out of range error on the LR = line.

When I put On Error Resume Next back in, that is where the error appears
 
Upvote 0
Okay, When I hover over MyString, it says MyString = Empty

Code: 
Sub DropShip()
MyDate = DateSerial(Year(Date), Month(Date) - 1, 1)
MyMonth = Format(MyDate, "mmmm")
MyYear = Year(MyDate)
MyPath = "C:\Documents and Settings\JThomps2\Desktop\WorkflowOne\Billing\" & MyYear & "\" & MyMonth & "\Drop Ship\"
MyFile = MyMonth & " " & MyYear & ".xls"
MyPDFile = "TPD " & MyMonth & " " & MyYear & ".xls"
MyMasterPath = "C:\Documents and Settings\JThomps2\Desktop\WorkflowOne\Billing\" & MyYear & "\"
MyMaster = "WFO Daily Postage Log" & MyYear & ".update.xls"
Dim c As Range
Dim X As Variant
Dim CurBook As Worksheet
Dim SrceBook As Workbook
Set CurBook = Workbooks("WFO Daily Postage Log" & MyYear & ".update.xls").Sheets(MyMonth & " " & MyYear)
Set SrceBook = Workbooks.Open(MyPath & MyFile)
For Each c In CurBook.Range(CurBook.[B50], CurBook.Cells(Rows.Count, "B").End(xlUp))
Select Case c.Value
    Case "12000 - The Birmingham News"
        MyString = "Birmingham"
    Case "12100 - The Grand Rapids Press"
        MyString = "Grand Rapids"
    Case "12200 - The Post-Standard"
        MyString = "Post Standard"
    Case "13100 - The Republican"
        MyString = "Republican"
    Case "13500 - The Huntsville Times"
        MyString = "Huntsville"
    Case "13600 - Kalamazoo Gazette"
        MyString = "Kalamazoo"
    Case "14600 - The Express-Times"
        MyString = "Express Times"
    Case "14800 - The Muskegon Chronicle"
        MyString = "Muskegon"
    Case "17100 - NJN Publishing"
        MyString = "N Jersey"
    Case "19130 - Valley Publishing"
        MyString = "BC-Sag"
        
End Select
        On Error Resume Next
        X = ""
        X = SrceBook.Sheets(MyString).Name
        On Error GoTo 0
        If X = MyString Then
            LR = SrceBook.Sheets(MyString).Cells(Rows.Count, "B").End(xlUp).Row
            X = Application.Match(c.Offset(0, 1).Value, SrceBook.Sheets(MyString).Range("B2:B" & LR), 0)
            If IsError(X) Then
                c.Offset(0, 4).ClearContents
            Else
                c.Offset(0, 4).Formula = "=VLookup(" & c.Offset(0, 1).Address & ", '" & MyPath & "[" & MyFile & "]" & MyString & "'!B5:D" & LR & ", 3, False)"
            End If
        Else
            c.Offset(0, 4).ClearContents
        End If
    
Next c
End Sub
 
Upvote 0
OK, try adding in a Case Else, to handle cases when the value isn't one of your sheets...

Code: 
    Case "19130 - Valley Publishing"
        MyString = "BC-Sag"
    Case Else
        MyString = "Doesn't Exist" 'Make sure there is NOT a sheet named "Doesn't Exist"
        
End Select
        On Error Resume Next
        X = ""
        X = SrceBook.Sheets(MyString).Name
        On Error GoTo 0
        If X = MyString Then
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question
VBA crashes randomly in middle of procedure for only one user
Replies
1
Views
2K
JLGWhiz
JLGWhiz
C
  • Question
Please help: VLOOKUP external workbook with concatenated file name
Replies
3
Views
4K
markmzz
M
D
  • Question
Vlookup in VBA based on workbook name to outlook .TO= field
Replies
0
Views
1K
diabloxx
D
M
  • Question
Vlookup with Dynamic Range
Replies
5
Views
444
T. Valko
T. Valko
J
  • Question
Macro to save as .txt is inserting double quotes around some data???
Replies
4
Views
1K
afatac
A

Forum statistics

Threads
1,214,606
Messages
6,120,483
Members
448,967
Latest member
visheshkotha

Share this page

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