VBA refining range

Question

I am attempting to draw data from a separate sheet and put it into a corresponding cell if the conditions are met. My code works, but it is not efficient. I do not know how to change the For Next loop so that it attempts to draw data only until the final entry. Right now I have it set to go a hundred or so cells further than I need so that I wouldn't have to update the code as often when I input new data to the data sheet (or at least that was the thought). Here is my code:

Sub LRearTest()
   Dim R As Integer
   Dim j As Integer

      For j = 89 To 250
          For R = 1 To 300

           If Worksheets("Input").Cells(j, 22).Value >= Worksheets("1036L").Cells(R, 5).Value And Worksheets("Input").Cells(j, 22).Value <= Worksheets("1036L").Cells(R, 6).Value Then
         Worksheets("Input").Cells(j, 20).Value = Worksheets("1036L").Cells(R, 3).Value

          End If
       Next R
    Next j
End Sub

The problem is when I run this code it takes almost two minutes before it is over. I am not sure if it is because I have used j and r as integers or what. Also I have a dozen of these on one module so I am not sure if that contributes. The code works like I said, it is just far too slow. Help is greatly appreciated.

The point that I am checking is in Column V of Sheet "Input". Each of my columns that I want to populate, F - U, use the same data in column V. The sheets that I am comparing the data in column V against are labeled as 1030L, 1030R, 1031L, 1031R, 1032L, 1032R, 1033L, 1033R, 1034L, 1034R, 1034LA, 1034RA, 1035L, 1035R, 1036L, and 1036R. The data being compared is in the same columns in every sheet. Thank you

Answer 1

Something like this should work for you:

Sub LRearTest()

    Dim wb As Workbook
    Dim wsInput As Worksheet
    Dim wsData As Worksheet
    Dim aDataParams() As String
    Dim aInput As Variant
    Dim aData As Variant
    Dim InputIndex As Long
    Dim DataIndex As Long
    Dim ParamIndex As Long
    Dim MinCol As Long

    Set wb = ActiveWorkbook
    Set wsInput = wb.Sheets("Input")

    'Adjust the column associations for each sheet as necessary
    ReDim aDataParams(1 To 16, 1 To 3)
    aDataParams(1, 1) = "1030L":    aDataParams(1, 2) = "F"
    aDataParams(2, 1) = "1030R":    aDataParams(2, 2) = "G"
    aDataParams(3, 1) = "1031L":    aDataParams(3, 2) = "H"
    aDataParams(4, 1) = "1031R":    aDataParams(4, 2) = "I"
    aDataParams(5, 1) = "1032L":    aDataParams(5, 2) = "J"
    aDataParams(6, 1) = "1032R":    aDataParams(6, 2) = "K"
    aDataParams(7, 1) = "1033L":    aDataParams(7, 2) = "L"
    aDataParams(8, 1) = "1033R":    aDataParams(8, 2) = "M"
    aDataParams(9, 1) = "1034L":    aDataParams(9, 2) = "N"
    aDataParams(10, 1) = "1034R":   aDataParams(10, 2) = "O"
    aDataParams(11, 1) = "1034LA":  aDataParams(11, 2) = "P"
    aDataParams(12, 1) = "1034RA":  aDataParams(12, 2) = "Q"
    aDataParams(13, 1) = "1035L":   aDataParams(13, 2) = "R"
    aDataParams(14, 1) = "1035R":   aDataParams(14, 2) = "S"
    aDataParams(15, 1) = "1036L":   aDataParams(15, 2) = "T"
    aDataParams(16, 1) = "1036R":   aDataParams(16, 2) = "U"

    'Find minimum column
    MinCol = wsInput.Columns.Count
    For ParamIndex = LBound(aDataParams, 1) To UBound(aDataParams, 1)
        If wsInput.Columns(aDataParams(ParamIndex, 2)).Column < MinCol Then MinCol = wsInput.Columns(aDataParams(ParamIndex, 2)).Column
    Next ParamIndex

    'Based on minimum column, determine column indexes for each sheet/column pair
    For ParamIndex = LBound(aDataParams, 1) To UBound(aDataParams, 1)
        aDataParams(ParamIndex, 3) = wsInput.Columns(aDataParams(ParamIndex, 2)).Column - MinCol + 1
    Next ParamIndex

    With wsInput.Range("F89", wsInput.Cells(wsInput.Rows.Count, "V").End(xlUp))
        If .Row < 89 Then
            MsgBox "No data in sheet [" & wsInput.Name & "]"
            Exit Sub
        End If
        aInput = .Value
    End With

    For ParamIndex = LBound(aDataParams, 1) To UBound(aDataParams, 1)
        'Define data sheet based on current column
        Set wsData = wb.Sheets(aDataParams(ParamIndex, 1))
        aData = wsData.Range("C1", wsData.Cells(wsData.Rows.Count, "F").End(xlUp)).Value

        For InputIndex = LBound(aInput, 1) To UBound(aInput, 1)
            For DataIndex = LBound(aData, 1) To UBound(aData, 1)
                If aInput(InputIndex, UBound(aInput, 2)) >= aData(DataIndex, 3) _
                And aInput(InputIndex, UBound(aInput, 2)) <= aData(DataIndex, 4) Then
                    aInput(InputIndex, aDataParams(ParamIndex, 3)) = aData(DataIndex, 1)
                    Exit For
                End If
            Next DataIndex
        Next InputIndex

        Set wsData = Nothing
        Erase aData
    Next ParamIndex

    wsInput.Range("F89").Resize(UBound(aInput, 1), UBound(aInput, 2)) = aInput

    Set wb = Nothing
    Set wsInput = Nothing
    Set wsData = Nothing
    Erase aInput
    Erase aData
    Erase aDataParams

End Sub