Refactoring nested 'If' statements

Question

Here is some code which loops through an area in a spreadsheet and executes the code based on the condition that the source cells do not contain the value "(blank)". The code works, but its very inefficient to run nested if statements in this manner. I've tried to have a go at making it more efficient in the long run but I'm out of ideas.

Any suggestions?

Sub NestedIfStatement()
Dim lastrow1 As Long
Dim I As Integer, J As Integer, N As Integer, MaxPriority as Integer
Dim Maxnumber as Range
Dim WS1 As Worksheet, WS3 as Worksheet
Dim WB As Workbook

Set WB = ThisWorkbook
Set WS1 = WB.Worksheets("Config")
Set WS2 = WB.Worksheets("Data")
Set WS3 = WB.Worksheets("Status Report") 

lastrow1 = WS1.Cells(Rows.Count, 1).End(xlUp).Row
I = 1
J = 1    
N = 3
Set Maxnumber = WS1.Range("A" & I & ":A" & lastrow1)
    MaxPriority = Application.Max(Maxnumber)

For J = 1 To lastrow1
    If WS1.Cells(J, 1) <= MaxPriority Then
       If WS1.Cells(J, 6).Value <> "(blank)" Then
          WS3.Cells(N, 7).Value = WS1.Cells(J, 6).Value
       End If
       If WS1.Cells(J, 5).Value <> "(blank)" Then
          WS3.Cells(N, 6).Value = WS1.Cells(J, 5).Value
       End If
       If WS1.Cells(J, 4).Value <> "(blank)" Then
          WS3.Cells(N, 4).Value = WS1.Cells(J, 4).Value
       End If
       If WS1.Cells(J, 3).Value <> "(blank)" Then
          WS3.Cells(N, 3).Value = WS1.Cells(J, 3).Value
       End If
       If WS1.Cells(J, 2).Value <> "(blank)" Then
          WS3.Cells(N, 2).Value = WS1.Cells(J, 2).Value
       End If
       N = N + 1
    End If
Next J

End Sub

Answer 1

Have you tried switching Calculation mode to manual before the loop then switch it back after the loop? What you describing is like there are lots of calculations to be refreshed on each change in WS3. Also turning off ScreenUpdating may help.

So, something like this:

Dim CalcMode As Long
'...
Application.ScreenUpdating = False
CalcMode = Application.Calculation
Application.Calculation = xlCalculationManual ' Change it to manual update
For J = 1 To lastrow1
    '...
Next
Application.Calculation = CalcMode ' Restore to what it was before
Application.ScreenUpdating = True

Alternatively, you can load the values in WS1 into Array (Variant), then do the nested If.

Another issue that you may have is you didn't Clear contents of WS3 before the loop fill in details which makes irrelevant data.

---

EDIT (possible solution)

Based on what your code is trying to achieve, you could have just use VBA to assign Formula to the associated cells - no loops!

Assuming there is a header at row 2 in WS3, the resulting FormulaR1C1 for columns B, C, D is:
=IF(Config!R[-2]C<>"(blank)",Config!R[-2]C,"")
and columns F, G is:
=IF(Config!R[-2]C[-1]<>"(blank)",Config!R[-2]C[-1],"")

To make formulas more generic, I put '<S1>' into const string. The lastrow3 is basically the last row that needs these formulas in WS3, and it depends on number of rows used in column A of WS1.

Please do time the difference and post back using this code, we are all curious about efficiency with real world data.

Option Explicit

Sub NestedIfStatement()
    Const Formula_FG = "=IF('<S1>'!R[-2]C[-1]<>""(blank)"",'<S1>'!R[-2]C[-1],"""")"
    Const Formula_BCD = "=IF('<S1>'!R[-2]C<>""(blank)"",'<S1>'!R[-2]C,"""")"

    Dim CalcMode As Long, sFormula As String
    Dim lastrow3 As Long
    Dim WS1 As Worksheet

    Application.ScreenUpdating = False
    CalcMode = Application.Calculation
    Application.Calculation = xlCalculationManual

    With ThisWorkbook
        Set WS1 = .Worksheets("Config")
        lastrow3 = WS1.Cells(Rows.Count, 1).End(xlUp).Row + 2 ' Offset from row 1 to 3 (N)
        With .Worksheets("Status Report")
            .UsedRange.Offset(1, 0).ClearContents ' Remove old data below the header row
            sFormula = Replace(Formula_BCD, "<S1>", WS1.Name)
            .Range("B3:D" & lastrow3).FormulaR1C1 = sFormula
            sFormula = Replace(Formula_FG, "<S1>", WS1.Name)
            .Range("F3:G" & lastrow3).FormulaR1C1 = sFormula
        End With
        Set WS1 = Nothing
    End With

    Application.Calculation = CalcMode
    Application.ScreenUpdating = True

End Sub

Answer 2

There are a number of holes in your variable declaration and assignment that could not be properly transcribed to a variant array method but perhaps this will help.

Sub Nested_UnIf_Statement()
    Dim WS1 As Worksheet, WS3 As Worksheet, Maxnumber As Range
    Dim lastrow1 As Long, I As Long, N As Long, MaxPriority As Long
    Dim v As Long, vWS1s As Variant, vWS3BDs As Variant, vWS3FGs As Variant

    Debug.Print Timer
    Set WS1 = Worksheets("Sheet2")
    Set WS3 = Worksheets("Sheet3")

    I = 2
    With WS1
        lastrow1 = .Cells(Rows.Count, 1).End(xlUp).Row
        Set Maxnumber = .Range("A" & I & ":A" & lastrow1)
        MaxPriority = Application.Max(Maxnumber)
        vWS1s = WS1.Range("A" & I & ":F" & lastrow1).Value2
        ReDim vWS3BDs(1 To 3, 1 To 1)
        ReDim vWS3FGs(1 To 2, 1 To 1)
    End With

    For v = LBound(vWS1s, 1) To UBound(vWS1s, 1)
        If vWS1s(v, 1) <= MaxPriority Then
            vWS3BDs(1, UBound(vWS3BDs, 2)) = Replace(vWS1s(v, 2), "(blank)", "")
            vWS3BDs(2, UBound(vWS3BDs, 2)) = Replace(vWS1s(v, 3), "(blank)", "")
            vWS3BDs(3, UBound(vWS3BDs, 2)) = Replace(vWS1s(v, 4), "(blank)", "")
            vWS3FGs(1, UBound(vWS3FGs, 2)) = Replace(vWS1s(v, 5), "(blank)", "")
            vWS3FGs(2, UBound(vWS3FGs, 2)) = Replace(vWS1s(v, 6), "(blank)", "")
            ReDim Preserve vWS3BDs(LBound(vWS3BDs, 1) To UBound(vWS3BDs, 1), LBound(vWS3BDs, 2) To UBound(vWS3BDs, 2) + 1)
            ReDim Preserve vWS3FGs(LBound(vWS3FGs, 1) To UBound(vWS3FGs, 1), LBound(vWS3FGs, 2) To UBound(vWS3FGs, 2) + 1)
        End If
    Next v

    ReDim Preserve vWS3BDs(LBound(vWS3BDs, 1) To UBound(vWS3BDs, 1), LBound(vWS3BDs, 2) To UBound(vWS3BDs, 2) - 1)
    ReDim Preserve vWS3FGs(LBound(vWS3FGs, 1) To UBound(vWS3FGs, 1), LBound(vWS3FGs, 2) To UBound(vWS3FGs, 2) - 1)

    N = 3
    WS3.Cells(N, 2).Resize(UBound(vWS3BDs, 2), UBound(vWS3BDs, 1)) = _
       Application.Transpose(vWS3BDs)
    WS3.Cells(N, 2).Offset(0, UBound(vWS3BDs, 1) + 1).Resize(UBound(vWS3FGs, 2), UBound(vWS3FGs, 1)) = _
       Application.Transpose(vWS3FGs)

    Debug.Print Timer

End Sub

On 5000 rows of randomized data, your original routine ran in 00:00:01.10 seconds while this one ran in 00:00:00.13 seconds. The results were identical.