-1

I am completely new to VBA so please bear with me.

I am trying to write a sub-procedure that will loop through each row in a certain column and compare to another sheet's criteria. if it contains "x", for example, then the value will be returned. However, when I try running the code, the codes run forever and causes the computer to hang.

Here's the code that I have written so far. It keeps prompting an error: Object variable and with block variable not set. PS: I have obtained errors when using 'Application.WorksheetFunction.Index' and when reading other threads, it was suggested to delete 'WorksheetFunction'. I'm not sure if that causes the problem and I would also like to clarify the rationale behind removing the words 'WorksheetFunction'

Thank you so much in advance!

Sub sub_inputData()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim lastrow as range 
lastrow = ws.Cells (ws.Rows.Count, 17).End (xlUp).row 

Dim rng As Range
Set rng = ws.Range("Q4:Q" & lastrow)
Dim rngCell As Range

On Error Resume Next

For Each rngCell In rng
    If rngCell.Offset(0, -13) = "x" Then
       rngCell = Application.Index(Sheets("Data").Range _
       ("D805:D813"), Application.Match(rngCell.Offset(0, -15), Sheets("Data").Range _
       ("D805:D813"), 1))
    ElseIf rngCell.Offset(0, -13) = "y" Then
       rngCell = Application.Index(Sheets("Data").Range _
       ("D27:D34"), Application.Match(rngCell.Offset(0, -15), Sheets("Data").Range _
       ("D27:D34"), 1))
    ElseIf rngCell.Offset(0, -13) = "z" Then
       rngCell = Application.Index(Sheets("Data").Range _
       ("D718:D726"), Application.Match(rngCell.Offset(0, -15), Sheets("Data").Range _
       ("D718:D726"), 1))
    Else: rngCell = vbNullString
    End If

Next rngCell

     Call sub_code2
     Call sub_code3
     Set rngCell = Nothing
     Set rng = Nothing
End Sub 
Lucky0683
  • 123
  • 1
  • 1
  • 9

3 Answers3

1

Couple issue with your code that has been modified here.
1) Dim lastrow As Long, not Range
2) Else: is not necessary, just use Else
3) Set rngCell = Nothing & Set rng = Nothing is not necessary. See this link for explanation
4) Since you are only checking the value of 1 cell, you can use Select Case for a moderately cleaner code.
5) On Error Resume Next is no good for de-bugging code. You want to see the errors so you can handle them. I recommend looking up the do's and dont's of that bit of code.

Sub sub_inputData()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim lastrow As Long: lastrow = ws.Range("Q" & ws.Rows.Count).End(xlUp).Row
Dim rng As Range: Set rng = ws.Range("Q4:Q" & lastrow)
Dim rngCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each rngCell In rng
    Select Case rngCell.Offset(0, -13)
        Case "x"
            rngCell = Application.Index(Sheets("Data").Range _
            ("D805:D813"), Application.Match(rngCell.Offset(0, -15), Sheets("Data").Range _
            ("D805:D813"), 1))
        Case "y"
            rngCell = Application.Index(Sheets("Data").Range _
            ("D27:D34"), Application.Match(rngCell.Offset(0, -15), Sheets("Data").Range _
            ("D27:D34"), 1))
        Case "z"
            rngCell = Application.Index(Sheets("Data").Range _
            ("D718:D726"), Application.Match(rngCell.Offset(0, -15), Sheets("Data").Range _
            ("D718:D726"), 1))
        Case Else
            rngCell = ""
    End Select
Next rngCell

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

     Call sub_code2
     Call sub_code3
End Sub
urdearboy
  • 14,439
  • 5
  • 28
  • 58
0

another possibility is using Switch() function:

Sub sub_inputData()
    Dim rngCell As Range, rangeToSearch As Range
    Dim val As Variant

    With ActiveSheet ' reference data sheet (better: With Worksheets("MyDataSheetName"))
        For Each rngCell In .Range("Q4", .Cells(.Rows.Count, "Q").End(xlUp)) ' loop throughreferenced sheet column Q cells from row 4 down to last not empty one
            val = rngCell.Offset(, -13).Value2 ' store column D current cell row value
            Set rangeToSearch = Sheets("Data").Range(Switch(val = "x", "D805:D813", val = "y", "D27:D34", val = "z", "D718:D726", True, "A1")) ' set range to search into with respect to stored value. set it to "A1" to signal no search is needed
            If rangeToSearch.Address <> "$A$1" Then ' if search is needed 
                rngCell.Value = Application.Index(rangeToSearch, Application.Match(rngCell.Offset(, -15).Value2, rangeToSearch, 1)) 'do the lookup
            Else
                rngCell.ClearContents ' clear current cell
            End If
        Next
    End With

    sub_code2 ' no need for 'Call' keyword
    sub_code3 ' no need for 'Call' keyword
End Sub
DisplayName
  • 13,283
  • 2
  • 11
  • 19
0

It looks like you are effectively picking a lookup range based on the value in column D, and then doing a lookup against that range based on the value in column B.

If so, you can do this entirely with formulas, which will be more efficient because it will only run on particular cells when needed (i.e. only when their inputs change).

Here's an example, using Tables and Table Notation. Tables are perfect for this, as you never have to amend your formulas to handle new data.

The formula in C2 is =VLOOKUP([@ID],CHOOSE(VLOOKUP([@Condition],Conditions,2,FALSE),X,Y,Z),2,FALSE)

That formula uses the 'Conditions' Table in E1:F3 to work out which of the other tables to do the lookup on. I've named those other tables X, Y, and Z.

enter image description here

jeffreyweir
  • 4,668
  • 1
  • 16
  • 27
  • I didn't choose to do vlookup because there are couple more criteria that I have to satisfy/lookup before they return me a value. And I kept getting errors with the 'if' functions as well :/ – Lucky0683 Jul 02 '18 at 00:50
  • OK. You could always add them into your original question. The CHOOSE function will certainly let you do this more efficiently without VBA. – jeffreyweir Jul 02 '18 at 10:07