Loop to multiple sheets with multiple criteria to get the price-CodePudding

I have a workbook with several worksheets. The main worksheet is the Data worksheet. The search criteria are in the Data worksheet B2,C2 and D2.The other sheets are cross tabs in which the prices are located. The prices I am looking for should be transferred in sheet Data column G2. I stuck with following code.

Dim wks As Worksheet
    Dim wksData As Worksheet: Set wksData = Sheets("Data")
    Dim lngrow As Long
    Dim lngrow2 As Long
    Dim lngSpalte As Long
    
    For lngrow = 2 To wksData.Cells(Rows.Count, 2).End(xlUp).Row
        Select Case wksData.Cells(lngrow, 2).Value
            Case "Standard"
                Set wks = Sheets("Standard")
            Case "Express Plus"
                Set wks = Sheets("Express Plus")
            Case "Express Saver"
                Set wks = Sheets("Express Saver")
        End Select
        For lngrow2 = 2 To wks.Cells(Rows.Count, 2).End(xlUp).Row
           If Trim(wks.Cells(lngrow2, 2).Value) = Trim(wksData.Cells(lngrow, 3).Value) Then
                For lngSpalte = 2 To 10
                    If Trim(wks.Cells(lngSpalte, 3).Value) = Trim(wksData.Cells(lngrow, 4)) Then
                        wksData.Cells(lngrow, 7).Value = wks.Cells(lngrow2, lngSpalte).Value
                        Exit For
                    End If
                Next
            End If
        Next
     Next

Is anyone able to help? Thank you!

CodePudding user response：

EDIT - based on your sample workbook...

Sub Tester()
    Dim wksData As Worksheet, wks As Worksheet
    Dim lngrow As Long
    Dim delType, delZone, delWeight, mCol, rv
    Dim rngWts As Range, arrWts, rngZones As Range, i As Long, w As Double
    
    Set wksData = Sheets("Data")
    For lngrow = 2 To wksData.Cells(Rows.Count, 2).End(xlUp).Row
        
        delType = Trim(wksData.Cells(lngrow, "B").Value) 'use some descriptive variables!
        delZone = wksData.Cells(lngrow, "C").Value
        delWeight = CDbl(Trim(wksData.Cells(lngrow, "D").Value))
        rv = ""  'clear result value
        Select Case delType
            Case "Standard", "Express Plus", "Express Saver"
                
                Set wks = Sheets(delType) 'simpler...
                Set rngWts = wks.Range("A3:A" & wks.Cells(Rows.Count, "A").End(xlUp).Row)
                arrWts = rngWts.Value
                'loop over the weights data
                For i = 1 To UBound(arrWts, 1) - 1
                    If delWeight >= arrWts(i, 1) And delWeight < arrWts(i   1, 1) Then
                        Set rngZones = wks.Range("B2", wks.Cells(2, Columns.Count).End(xlToLeft)) 'zones range
                        mCol = Application.Match(delZone, rngZones, 0)   'find the matching Zone
                        If Not IsError(mCol) Then                        'got zone match?
                            rv = rngWts.Cells(i).Offset(0, mCol).Value
                        Else
                            rv = "Zone?"
                        End If
                        Exit For 'stop checking weights column
                    End If
                Next i
                If Len(rv) = 0 Then rv = "No weight match"
                
            Case Else
                rv = "Delivery type?"
        End Select
        wksData.Cells(lngrow, "G").Value = rv 'populate the result
    Next
End Sub