Error when running VLookup

I've written a program which looks up a value which the user inputs together with the different option the user choose, I have to lookup this input value at different columns worksheets and return the values accordingly. Everything works fine until I add in the VLookup line. I get a RunTime Error 9 Subscript Out of RangeI've tried using a For Next loop instead of the VLookup but it gave an error too. Hopefully I've explained myself clearly.

Here's the code:

Code:

---

Private Sub UserForm_Initialize()
    SingleACText.Text = 230
    ThreeACText.Text = 400
    CaSCText.Text = "Table"
    CaOLText.Text = "Table"
    CgText.Text = "Table"
    CiText.Text = 0.5
 
   
'    Call SetBackColor(DataTable.TabIndex(0), vbLightOrange)
'    Call SetBackColor(DataTable.TabIndex(1), vbSkyBlue)
'    Call SetBackColor(DataTable.TabIndex(2), vbYellow)
'    Call SetBackColor(DataTable.TabIndex(3), vbGold)
   
    DataTable.ViewOnlyMode = True
    DataTable.Cells.Clear
    Worksheets("Ca").Range("A1:D19").Copy
    DataTable.Range("A1:D19").Paste
    DataTable.Selection.EntireColumn.AutoFit
    DataTable.Range("B7").Select
    DataTable.ActiveWindow.FreezePanes = True
    DataTable.Range("A1").Select
End Sub
Private Sub Tables_Change()
    Dim n As Integer
    DataTable.ViewOnlyMode = True
    n = Tables.SelectedItem.Index
'    Call SetBackColor(MultiPage1.Pages(0), vbYellow) 'Yellow.
'    Call SetBackColor(MultiPage1.Pages(1), RGB(255, 0, 0)) 'Red.
'    Call SetBackColor(MultiPage2.Pages(0), vbGreen) 'Green.
'    Call SetBackColor(MultiPage2.Pages(1), vbMagenta) 'Purple.
    Select Case n
        Case 0
            DataTable.Cells.Clear
            Worksheets("Ca").Range("A1:D19").Copy
            DataTable.Range("A1:D19").Paste
            DataTable.Selection.EntireColumn.AutoFit
            DataTable.Range("B7").Select
            DataTable.ActiveWindow.FreezePanes = True
            DataTable.Range("A1").Select
   
        Case 1
            DataTable.Cells.Clear
            Worksheets("Ca").Range("E1:H19").Copy
            DataTable.Range("A1:D19").Paste
            DataTable.Selection.EntireColumn.AutoFit
            DataTable.Range("B7").Select
            DataTable.ActiveWindow.FreezePanes = True
            DataTable.Range("A1").Select
           
        Case 2
            DataTable.Cells.Clear
            Worksheets("Cg").Range("A1:I24").Copy
            DataTable.Range("A1:I24").Paste
            DataTable.Selection.EntireColumn.AutoFit
            DataTable.Range("B7").Select
            DataTable.ActiveWindow.FreezePanes = True
            DataTable.Range("A1").Select

        Case 3
            DataTable.Cells.Clear
            Worksheets("ISO-AWG").Range("A1:C36").Copy
            DataTable.Range("A1:C36").Paste
            DataTable.Selection.EntireColumn.AutoFit
            DataTable.Range("6:6").Select
            DataTable.ActiveWindow.FreezePanes = True
            DataTable.Range("A1").Select

    End Select
End Sub
Private Sub ReturnCableLengthText_Change()
    ReturnCableLengthSpin.Value = Val(ReturnCableLengthText.Text)
End Sub
Private Sub ReturnCableLengthSpin_Change()
    ReturnCableLengthText.Text = ReturnCableLengthSpin.Value
End Sub
Private Sub LoadCurrentText_Change()
    LoadCurrentSpin.Value = Val(LoadCurrentText.Text)
End Sub
Private Sub LoadCurrentSpin_Change()
    LoadCurrentText.Text = LoadCurrentSpin.Value
End Sub
Private Sub OverloadCurrentText_Change()
    OverloadCurrentSpin.Value = Val(OverloadCurrentText.Text)
End Sub
Private Sub OverloadCurrentSpin_Change()
    OverloadCurrentText.Text = OverloadCurrentSpin.Value
End Sub
Private Sub CgText_Change()
    CgSpin.Value = Val(CgText.Text) * 100
End Sub
Private Sub CgSpin_Change()
    CgText.Text = CgSpin.Value * 0.01
End Sub
Private Sub CiText_Change()
    CiSpin.Value = Val(CiText.Text) * 100
End Sub
Private Sub CiSpin_Change()
    CiText.Text = CiSpin.Value * 0.01
End Sub


Private Sub Armoured_Change()
    Select Case Armoured.Value
        Case True: SingleCore.Enabled = False
        Case False: SingleCore.Enabled = True
    End Select
End Sub
Private Sub NonMagneticArmour_Change()
    Select Case NonMagneticArmour.Value
        Case True: MultiCore.Enabled = False
        Case False: MultiCore.Enabled = True
    End Select
End Sub
'Private Sub SingleCore_Change()
'    Select Case SingleCore.Value
'        Case True: Armoured.Enabled = False
'        Case False: Armoured.Enabled = True
'    End Select
'End Sub
'Private Sub MultiCore_Change()
'    Select Case MultiCore.Value
'        Case True: NonMagneticArmour.Enabled = False
'        Case False: NonMagneticArmour.Enabled = True
'    End Select
'End Sub
Private Sub TwoCoresCables_Change()
    Select Case TwoCoresCables.Value
        Case True: ThreeAC.Enabled = False
        Case False: ThreeAC.Enabled = True
    End Select
End Sub
Private Sub ThreeFourCoresCables_Change()
    Select Case ThreeFourCoresCables.Value
        Case True: DC.Enabled = False
                  SingleAC.Enabled = False
        Case False: DC.Enabled = True
                    SingleAC.Enabled = True
    End Select
End Sub
'Private Sub DC_Change()
'    Select Case DC.Value
'        Case True: OneTrefoil.Enabled = False
'                  ElevenTrefoil.Enabled = False
'                  TwelveTrefoil.Enabled = False
'        Case False: OneTrefoil.Enabled = True
'                    ElevenTrefoil.Enabled = True
'                    TwelveTrefoil.Enabled = True
'    End Select
'End Sub
'Private Sub DC_Change()
'    Select Case DC.Value
'        Case True: ThreeFourCoresCables.Enabled = False
'        Case False: ThreeFourCoresCables.Enabled = True
'    End Select
'End Sub
'Private Sub SingleAC_Change()
'    Select Case SingleAC.Value
'        Case True: ThreeFourCoresCables.Enabled = False
'        Case False: ThreeFourCoresCables.Enabled = True
'    End Select
'End Sub
'Private Sub ThreeAC_Change()
'    Select Case ThreeAC.Value
'        Case True: TwoCoresCables.Enabled = Fasle
'        Case False: Two CoresCables.Enabled = True
'    End Select
'End Sub
Private Sub Method1_Change()
    Select Case Method1.Value
        Case True: Select Case ThreeAC.Value
                      Case True: OneTrefoil.Enabled = True
                      Case False: OneTrefoil.Enabled = False
                  End Select
        Case False: OneTrefoil.Enabled = False
    End Select
End Sub
Private Sub Method11_Change()
    Select Case Method11.Value
        Case True: Select Case ThreeAC.Value
                      Case True: ElevenTrefoil.Enabled = True
                      Case False: ElevenTrefoil.Enabled = False
                  End Select
        Case False: ElevenTrefoil.Enabled = False
    End Select
End Sub
Private Sub Method12_Change()
    Select Case Method12.Value
        Case True: Select Case ThreeAC.Value
                      Case True: TwelveTrefoil.Enabled = True
                      Case False: TwelveTrefoil.Enabled = False
                    End Select
                  Horizontal.Enabled = True
                  Vertical.Enabled = True
        Case False: TwelveTrefoil.Enabled = False
                    Horizontal.Enabled = False
                    Vertical.Enabled = False
    End Select
End Sub
Private Sub TwelveTrefoil_Change()
    Select Case TwelveTrefoil.Value
        Case True: Horizontal.Enabled = False
                  Vertical.Enabled = False
        Case False: Horizontal.Enabled = True
                    Vertical.Enabled = True
    End Select
End Sub
Private Sub Horizontal_Change()
    Select Case Horizontal.Value
        Case True: TwelveTrefoil.Enabled = False
        Case False: TwelveTrefoil.Enabled = True
    End Select
End Sub
Private Sub Vertical_Change()
    Select Case Vertical.Value
        Case True: TwelveTrefoil.Enabled = False
        Case False: TwelveTrefoil.Enabled = True
    End Select
End Sub


Private Sub OKButton_Click()
    Dim Msg As String
    Dim Ct As Single
'    Dim WorksheetName As String
'    Dim WorksheetNumber As Integer

   
    'Display Messages
    If Aluminium Then Msg = Msg & Aluminium.Caption
    If Copper Then Msg = Msg & Copper.Caption

    If PVC Then Msg = Msg & " " & PVC.Caption
    If PVC Then WorksheetName = "DataPVC"
    'If Rubber Then Msg = Msg & vbNewLine & Rubber.Caption
    If Thermosetting Then Msg = Msg & " " & Thermosetting.Caption
    If Thermosetting Then WorksheetName = "DataThermo"

    If Armoured Then Msg = Msg & vbNewLine & Armoured.Caption
    If Armoured Then WorksheetNumber = "3"
    If NonArmoured Then Msg = Msg & vbNewLine & NonArmoured.Caption
    If NonArmoured Then WorksheetNumber = "1"
    If NonMagneticArmour Then Msg = Msg & vbNewLine & NonMagneticArmour.Caption
    If NonMagneticArmour Then WorksheetNumber = "3"
   
    If Method1 Then Msg = Msg & " " & Method1.Caption
    If Method3 Then Msg = Msg & " " & Method3.Caption
    If Method4 Then Msg = Msg & " " & Method4.Caption
    If Method11 Then Msg = Msg & " " & Method11.Caption
    If Method12 Then Msg = Msg & " " & Method12.Caption
    If Method13 Then Msg = Msg & " " & Method13.Caption
    If OneTrefoil Then Msg = Msg & " " & OneTrefoil.Caption
    If ElevenTrefoil Then Msg = Msg & " " & ElevenTrefoil.Caption
    If TwelveTrefoil Then Msg = Msg & " " & TwelveTrefoil.Caption
    If Horizontal Then Msg = Msg & " " & Horizontal.Caption
    If Vertical Then Msg = Msg & " " & Vertical.Caption
   
    If MultiCore Then WorksheetNumber = WorksheetNumber + 1
    If SingleCore Then WorksheetNumber = WorksheetNumber + 0

    WorksheetName = WorksheetName & WorksheetNumber

    If TwoCoresCables Then
        Select Case MultiCore.Value
            Case True: Msg = Msg & vbNewLine & "2 Core - " & MultiCore.Caption & " Cables"
            Case False: Select Case SingleCore.Value
                                Case True: Msg = Msg & vbNewLine & "2 " & SingleCore.Caption & " Cables"
                                Case False: Msg = Msg
                        End Select
        End Select
    End If
    If ThreeFourCoresCables Then
        Select Case MultiCore.Value
            Case True: Msg = Msg & vbNewLine & "3/4 Core - " & MultiCore.Caption & " Cables"
            Case False: Select Case SingleCore.Value
                                Case True: Msg = Msg & vbNewLine & "3/4 " & SingleCore.Caption & " Cables"
                                Case False: Msg = Msg
                        End Select
        End Select
    End If
   
    If DC Then Msg = Msg & vbNewLine & DC.Caption & " " & DCText.Text & "V"
    If SingleAC Then Msg = Msg & vbNewLine & SingleAC.Caption & " " & SingleACText.Text & "V"
    If ThreeAC Then Msg = Msg & vbNewLine & ThreeAC.Caption & " " & ThreeACText.Text & "V"
   
    Msg = Msg & vbNewLine
   
    If ReturnCableLengthText.Text = Empty Then ReturnCableLengthText.Text = "0"
    Msg = Msg & vbNewLine & "Return Cable Length: " & ReturnCableLengthText.Text & " m"
    If LoadCurrentText.Text = Empty Then LoadCurrentText.Text = "0"
    Msg = Msg & vbNewLine & "Load Current:            " & LoadCurrentText.Text & " A"
    If OverloadCurrentText.Text = Empty Then OverloadCurrentText.Text = "0"
    Msg = Msg & vbNewLine & "Overload Current:      " & OverloadCurrentText.Text & " A"
   
    Msg = Msg & vbNewLine
   
    If CaSCText.Text = Empty Then CaSCText.Text = "0"
    Msg = Msg & vbNewLine & "CaSC: " & CaSCText.Text
    If CaOLText.Text = Empty Then CaOLText.Text = "0"
    Msg = Msg & vbNewLine & "CaOL: " & CaOLText.Text
    If CgText.Text = Empty Then CgText.Text = "0"
    Msg = Msg & vbNewLine & "Cg:    " & CgText.Text
    'CiText.Text preset to 0.5
    Msg = Msg & vbNewLine & "Ci:      " & CiText.Text
    If MCB Then Ct = 1
    If SemiEnclosedFuse Then Ct = 0.725
    Msg = Msg & vbNewLine & "Ct:      " & Ct
   
   
    'Reference Data Calculation
'    Dim Row As Integer
    Dim Column As Integer
    Dim Multiplier As Integer
    Dim i As Integer
    Dim CurrentCarryingCapacity As Variant
    Dim VoltageDrop As Integer
   
    If TwoCoresCables Then Column = 2
    If ThreeFourCoresCables Then Column = 38
   
    If DC Then Column = Column + 0
    If DC Then Multiplier = 1
    If SingleAC Then Column = Column + 8
    If SingleAC Then Multiplier = 4
    If ThreeAC Then Column = Column + 0
    If ThreeAC Then Multiplier = 4
   
    If Method1 Then Column = Column + Multiplier * 0
    If Method3 Then Column = Column + Multiplier * 1
    If Method4 Then Column = Column + Multiplier * 2
    If Method11 Then Column = Column + Multiplier * 3
    If Method12Horizontal Then Column = Column + Multiplier * 4
    If Method12Vertical Then Column = Column + Multiplier * 5
    If Method13 Then Column = Column + Multiplier * 6
    If OneTrefoil Then Column = Column + Multiplier * 7
    If ElevenTrefoil Then Column = Column + Multiplier * 8
    If TwelveTrefoil Then Column = Column + Multiplier * 9
   
    If DC Then VoltageDrop = 9
    If DC Then ReturnColumn = VoltageDrop - Column + 1
    If SingleAC Then VoltageDrop = Column + 3
    If ThreeAC Then VoltageDrop = Column + 3
   
    Msg = Msg & vbNewLine & VoltageDrop
   
    If Aluminium Then
            CurrentCarryingCapacity = WorksheetFunction.VLookup(LoadCurrentText.Text, Worksheets("WorksheetName").Range(Cells(10, Column), Cells(26, VoltageDrop)), ReturnColumn, False)
    End If
    If Copper Then
            CurrentCarryingCapacity = WorksheetFunction.VLookup(LoadCurrentText.Text, Worksheets("WorksheetName").Range(Cells(28, Column), Cells(49, VoltageDrop)), ReturnColumn)
    End If


    Msg = Msg & vbNewLine & Column
    Msg = Msg & vbNewLine & i
    Msg = Msg & vbNewLine & VoltageDrop
    Msg = Msg & vbNewLine & WorksheetName
    Msg = Msg & vbNewLine & CurrentCarryingCapacity
 
    Display9.Text = Msg
    Display9.MultiLine = True
End Sub
Private Sub CancelButton_Click()
    Unload CableSizingSelection
End Sub

---

change instances of:
Worksheets("WorksheetName")
to
Worksheets(WorksheetName)

Hi p45cal, thank you for your reply. I've changed them and it gives this me : Run-time error '1004', Application-defined / Object-defined error. I've actually set WorksheetName as the name of my worksheet so shouldn't it be in " " ? as it is not the worksheet number.

Could you please attach the file so that we can check what actually your code is doing.:confused:

Hi, LalitPandey87. Here you go:

Code:

---

Attachment 1492

---

I've deleted 6 worksheets: DataPVC2/3/4 and DataThermo2/3/4 in case you're wondering what they are in the program. They all have the same format as DataPVC1.

I've had a look at your file but there are a few problems;
I got a message that it couldn't load an object because the object was not available on my machine. Closer examination showed a missing reference to Microsoft Office Web Componenets 11.0 which is an Excel 2003 reference and I only have Excel 2010 here. So when I try to run code it balks.
There is commented-out code left right and centre and I'm not sure which code I should be testing (it all refuses to run anyway).

So I'll confine myself to general comments.

When it next errors out, choose Debug and then hover the mouse over the following variable names in the errant (highlighted in yellow) line (by the way, the one with NO quotes around WorksheetName):
WorksheetName
Column
VoltageDropColumn

Their values should pop up in a little box next to the cursor, and check they contain the values you expect, especially the WorksheetName, as this should contain a string with the EXACT (no extra spaces etc.) name of an existing sheet in the workbook.

I see in some place you have:
WorksheetNumber = "3"
where you've assigned a string to the variable, but later you have:
WorksheetNumber = WorksheetNumber + 1
where you're treating it as a number. I expect that Excel will coerce the value to the right type, both in the above line and in the later:
WorksheetName = WorksheetName & WorksheetNumber
but if you have Dimmed the variables to one type and you have an On Error Resume Next line somewhere, the WorksheetName will not contain quite what you expect.

Hi p45cal, sorry bout the confusion on the comments. Most of them are useless, just stuff I experimented with but left it there in case I want to get back to it. The line that should be running is this

Code:

---

VoltageDrop = WorksheetFunction.VLookup(Val(LoadCurrentText.Text), Worksheets(WorksheetName).Range(Cells(10, Column), Cells(26, VoltageDropColumn)), ReturnColumn)

---

which is uncommented at line 365.
I run this line several times throughout the codsso once I've figured out one of them, the rest should be fine as well.

As for the Microsoft Office Web Components, that's the spreadsheet in the userform which is currently working fine. So if you don't mind, you could delete that spreadsheet and in the codes that start with DataTable. lines:10 to 18, and the entire private_sub tables_change().

I have a total of 8 worksheets, from DataPVC1 to DataPVC4 and DataThermo1 to DataThermo4. I've deleted 6 of these worksheets as the file was too big to upload. I just realized I used the string format for the WorksheetNumber!! No wonder it only works for worksheets labelled 1. Thanks for pointing this out! I'll go try out again before updating here.

I've changed WorksheetNumber to be without quotes. But it doesn't seem to affect anything. I display the WorksheetName and it displays the correct stuff according to the different options I choose. The VLookup line still doesn't seem to work. The pop up box all shows the correct columns, worksheetname...all except for the first cells property: Cells(10, Column). It's showing the correct column, but the value of this cell, is from my active sheet and not the referenced sheet, meaning: It shows: Worksheets(DataPVC2) <--in the pop up box. BUT the cell displays the value from Worksheets(DataThermo2) <-- or whatever worksheet is active.

Quote:

---

Originally Posted by mcbrocks

Hi, LalitPandey87. Here you go:

Code:

---

Attachment 1492

---

I've deleted 6 worksheets: DataPVC2/3/4 and DataThermo2/3/4 in case you're wondering what they are in the program. They all have the same format as DataPVC1.

---

Sorry friend, it is not working on my system as Datatable object is missing in my system.

Attachment 1496 I compressed the folder. Not sure if this works

Quote:

---

Originally Posted by mcbrocks

all except for the first cells property: Cells(10, Column). It's showing the correct column, but the value of this cell, is from my active sheet and not the referenced sheet, meaning: It shows: Worksheets(DataPVC2) <--in the pop up box. BUT the cell displays the value from Worksheets(DataThermo2) <-- or whatever worksheet is active.

---

I think you've nailed it - and I should have seen this - the range is not properly qualified; the Cells(…) parts need to be qualified:

Code:

---

With Worksheets(WorksheetName)
  VoltageDrop = WorksheetFunction.VLookup(Val(LoadCurrentText.Text), .Range(.Cells(10, Column), .Cells(26, VoltageDropColumn)), ReturnColumn)
End With

---

paying especial attention to the dots in the code. The With… End With consruct could probably span more than one line.

p45cal, it works!!! I didn't know it had to be so specific. But however, I have some cells within the range that contain a 0 value. This throws off the desired result. Is there any line that can be put in to rectify the error? I tried this:

Code:

---

    If Worksheets(WorksheetName).Range(Worksheets(WorksheetName).Cells(10, Column), Worksheets(WorksheetName).Cells(26, Column)).Value = 0 Then
        Ans = MsgBox("This method does not exist for " & WorksheetName & ".", vbRetryCancel + vbExclamation)
        If Ans = vbRetry Then CableSizingSelection.UndoAction
        If Ans = vbCancel Then Unload CableSizingSelection
    End If

---

But the first If line is giving trouble.

Is there any other way to avoid the error? There are some columns where only the last few rows contain 0s and if the lookup value can be found within the top few lines, the program would have to work correctly. I realized the retry cancel actually searches for 0 values whether it affects the result or not. Maybe I could shorten the lookup range. Like say have the range from row 10 to the last non-0 cell?

Here's the updated copy of the worksheet when I switch to using index match instead of vlookup.
Attachment 1510

I've posted this question over here as well Error with index match function - Page 2