VBA multiple for statement workaround

[VeryForgetful]

Hi, can anyone recommend a better way of writing the code below please to eliminate the need for multiple loops.

[COLOR=#000000][FONT=&quot]Sub MaterialThreshold()[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]
[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    Dim DataSht As Worksheet[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    Dim MaterialRange As Range[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    Dim MaterialCheck As Integer[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    Dim ErrorCount As Integer[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    Dim lr As Long[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]
[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    Set DataSht = Sheets("Test")[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    Set MaterialRange = Sheets("Calculations").Range("M2:N15")[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]
[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    lr = DataSht.Range("B" & Rows.Count).End(xlUp).Row[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]
[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    DataSht.Range("J2:S" & lr).Interior.ColorIndex = xlNone[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]
[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    ErrorCount = 0[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]
[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    For Each c In DataSht.Range("J2:J" & lr)[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        On Error Resume Next[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        MaterialCheck = WorksheetFunction.VLookup(c, MaterialRange, 2, False)[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        If c.Offset(0, 1).Value > MaterialCheck Then[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]            ErrorCount = ErrorCount + 1[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]            Range(c, c.Offset(0, 1)).Interior.ColorIndex = 3[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        End If[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    Next c[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]
[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    For Each c In DataSht.Range("L2:L" & lr)[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        On Error Resume Next[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        MaterialCheck = WorksheetFunction.VLookup(c, MaterialRange, 2, False)[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        If c.Offset(0, 1).Value > MaterialCheck Then[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]            ErrorCount = ErrorCount + 1[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]            Range(c, c.Offset(0, 1)).Interior.ColorIndex = 3[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        End If[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    Next c[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]
[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    For Each c In DataSht.Range("N2:N" & lr)[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        On Error Resume Next[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        MaterialCheck = WorksheetFunction.VLookup(c, MaterialRange, 2, False)[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        If c.Offset(0, 1).Value > MaterialCheck Then[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]            ErrorCount = ErrorCount + 1[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]            Range(c, c.Offset(0, 1)).Interior.ColorIndex = 3[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        End If[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    Next c[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]
[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    For Each c In DataSht.Range("P2:P" & lr)[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        On Error Resume Next[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        MaterialCheck = WorksheetFunction.VLookup(c, MaterialRange, 2, False)[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        If c.Offset(0, 1).Value > MaterialCheck Then[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]            ErrorCount = ErrorCount + 1[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]            Range(c, c.Offset(0, 1)).Interior.ColorIndex = 3[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        End If[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    Next c[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]
[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    For Each c In DataSht.Range("R2:R" & lr)[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        On Error Resume Next[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        MaterialCheck = WorksheetFunction.VLookup(c, MaterialRange, 2, False)[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        If c.Offset(0, 1).Value > MaterialCheck Then[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]            ErrorCount = ErrorCount + 1[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]            Range(c, c.Offset(0, 1)).Interior.ColorIndex = 3[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]        End If[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    Next c[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]
[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    If ErrorCount > 0 Then MsgBox "There are " & ErrorCount & " jobs highlighted in red with potential errors." & _[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]       vbNewLine & vbNewLine & "Please check before sending", vbExclamation[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]
[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]End Sub[/FONT][/COLOR]

 

[JackDanIce]

Try:

Sub MaterialThreshold()
    
    Dim dic     As Object
    Dim x       As Long
    Dim y       As Long
    Dim errC    As Long
    Dim msg     As String
    
    Set dic = createojbect("Scripting.Dictionary")
    
    Application.ScreenUpdating = False
    
    With Sheets("Calculations")
        For x = 2 To 13
            dic(.Cells(x, 12).Value) = .Cells(x, 13).Value
        Next x
    End With
                        
    With Sheets("Test")
        x = .Cells(.Rows.count, 2).End(xlUp).row
        .Cells(2, 10).Resize(x - 1, 10).Interior.ColorIndex = xlNone
        For x = 2 To x
            For y = 10 To 18 Step 2
                On Error Resume Next
                If .Cells(x, y + 1).Value > dic(.Cells(x, y).Value) Then
                    .Cells(x, y).Resize(, 2).Interior.ColorIndex = 3
                    errC = errC + 1
                End If
                On Error GoTo 0
            Next y
        Next x
    End With
    
    Application.ScreenUpdating = True
    
    msg = "There are @EC jobs highlighted in red with potential errors!@1@1Please check before sending"
    msg = Replace(msg, "@EC", errC)
    msg = Replace(msg, "@1", vbCrLf)
    
    If errC Then MsgBox msg, vbExclamation, "Errors in EC Jobs Found!"
    
    Set dic = Nothing
    
End Sub

 

[VeryForgetful]

Works great thanks

 

[JackDanIce]

You're welcome