Looping multiple values within a loop

[Aurbo]

How would I loop this in a nest 25 times increasing the following values by 1 each time?

What:="M 01" to "M 25"
.Range("N1") to "N25"
.Range("M1") to "M25"
.Value = " Zone 1 " to " Zone 24" and last loop " Other "

Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 01", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        M1 = ActiveCell.Row - 1
        targetSheet.Range("N1").Value = M1
        targetSheet.Range("M2").Value = M1 + 2
        iFind.EntireRow.Insert Shift:=xlDown
        targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).FormatConditions.Delete
        targetSheet.Range("B" & M1 + 1).Value = " Zone 1 "
        targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).MergeCells = True
        targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).Select
        targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).RowHeight = 21
        Selection.Font.Bold = True
            With Selection.Font
                .Name = "Arial"
                .Size = 16
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
            End With
            With Selection.Interior
                .ColorIndex = 6
                .PatternColorIndex = xlAutomatic
            End With
         LastRow = LastRow + 1
    End If

[skywriter]

I don't find an M1, I find an M2, it's the line I colored. If that's not it you'll have to fix it.

EDIT:
Forgot about the Zone request.

Dim strM As String
Dim strZone As String
Dim c As Long

For c = 1 To 25
        If c < 10 Then
            strM = "0" & c
        Else
            strM = c
        End If
        
        If c < 25 Then
            strZone = " Zone " & c
        Else
            strZone = "Other"
        End If
        
                Set IFind = ws.Range("H1:C" & LastRow).Find(What:="M " & strM, LookIn:=xlValues, LookAt:=xlWhole)
            If Not IFind Is Nothing Then
                IFind.Activate
                M1 = ActiveCell.Row - 1
                targetSheet.Range("N" & c).Value = M1
                targetSheet.Range("M" & c).Value = M1 + 2
                IFind.EntireRow.Insert Shift:=xlDown
                targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).FormatConditions.Delete
                targetSheet.Range("B" & M1 + 1).Value = strZone
                targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).MergeCells = True
                targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).Select
                targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).RowHeight = 21
                Selection.Font.Bold = True
                    With Selection.Font
                        .Name = "Arial"
                        .Size = 16
                        .Strikethrough = False
                        .Superscript = False
                        .Subscript = False
                        .OutlineFont = False
                        .Shadow = False
                        .Underline = xlUnderlineStyleNone
                    End With
                    With Selection.Interior
                        .ColorIndex = 6
                        .PatternColorIndex = xlAutomatic
                    End With
                 LastRow = LastRow + 1
            End If
Next c

[skywriter]

Thanks for the rep. points.

[Aurbo]

After working with this sheet a few days I've discovered a new issue.

What:="M 01" to "M 25"

Every so often, one of the sections at work is not occupied for a day.

How would I trap that event if one of the "M xx" is missing and still continue the loop?

Dim strM As String
Dim strZone As String
Dim c As Long

For c = 1 To 25
        If c < 10 Then
            strM = "0" & c
        Else
            strM = c
        End If
        
        If c < 25 Then
            strZone = " Zone " & c
        Else
            strZone = "Other"
        End If
        
                Set IFind = ws.Range("H1:C" & LastRow).Find(What:="M " & strM, LookIn:=xlValues, LookAt:=xlWhole)
            If Not IFind Is Nothing Then
                IFind.Activate
                M1 = ActiveCell.Row - 1
                targetSheet.Range("N" & c).Value = M1
                targetSheet.Range("M" & c).Value = M1 + 2
                IFind.EntireRow.Insert Shift:=xlDown
                targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).FormatConditions.Delete
                targetSheet.Range("B" & M1 + 1).Value = strZone
                targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).MergeCells = True
                targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).Select
                targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).RowHeight = 21
                Selection.Font.Bold = True
                    With Selection.Font
                        .Name = "Arial"
                        .Size = 16
                        .Strikethrough = False
                        .Superscript = False
                        .Subscript = False
                        .OutlineFont = False
                        .Shadow = False
                        .Underline = xlUnderlineStyleNone
                    End With
                    With Selection.Interior
                        .ColorIndex = 6
                        .PatternColorIndex = xlAutomatic
                    End With
                 LastRow = LastRow + 1
            End If
Next c

[skywriter]

You don't need to trap it.
The code that says

If Not IFind Is Nothing Then

is checking to see if something was found.
If nothing was found then it goes all the way down to the End If statement and then to the Next C statement and looks for the next item.

[Aurbo]

Thanks, following your reply I found my issue was not with this section of code but in another.

 targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).FormatConditions.Delete
                targetSheet.Range("B" & M1 + 1).Value = strZone
                targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).MergeCells = True
                targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).Select
                targetSheet.Range("B" & M1 + 1 & ":I" & M1 + 1).RowHeight = 21

This section of code above creates a scratch pad area where those values are used to create a new range to check the Worksheet_BeforeDoubleClick function.

If the code above skips an input then the code below cannot complete the " If Not Application.Intersect(Target, Range" ...ranges and errors out.

I need to rework the code below to account for any missing entries created by the code above.


I'll do some more research to clean my the code I currently have and post it to see if other eyes can optimize it.

Thanks again

Public Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set ws = Sheets("EPB")
With ws
Na = "I" & ws.Range("M1").Value & ":I" & ws.Range("N1").Value
Nb = "I" & ws.Range("M2").Value & ":I" & ws.Range("N2").Value
Nc = "I" & ws.Range("M3").Value & ":I" & ws.Range("N3").Value
Nd = "I" & ws.Range("M4").Value & ":I" & ws.Range("N4").Value
Ne = "I" & ws.Range("M5").Value & ":I" & ws.Range("N5").Value
Nf = "I" & ws.Range("M6").Value & ":I" & ws.Range("N6").Value
Ng = "I" & ws.Range("M7").Value & ":I" & ws.Range("N7").Value
Nh = "I" & ws.Range("M8").Value & ":I" & ws.Range("N8").Value
Ni = "I" & ws.Range("M9").Value & ":I" & ws.Range("N9").Value
Nj = "I" & ws.Range("M10").Value & ":I" & ws.Range("N10").Value
Nk = "I" & ws.Range("M11").Value & ":I" & ws.Range("N11").Value
Nl = "I" & ws.Range("M12").Value & ":I" & ws.Range("N12").Value
Nm = "I" & ws.Range("M14").Value & ":I" & ws.Range("N14").Value
Nn = "I" & ws.Range("M15").Value & ":I" & ws.Range("N15").Value
Np = "I" & ws.Range("M16").Value & ":I" & ws.Range("N16").Value
Nq = "I" & ws.Range("M17").Value & ":I" & ws.Range("N17").Value
Nr = "I" & ws.Range("M18").Value & ":I" & ws.Range("N18").Value
Ns = "I" & ws.Range("M19").Value & ":I" & ws.Range("N19").Value
Nx = "I" & ws.Range("M20").Value & ":I" & ws.Range("N20").Value
Nz = "I" & ws.Range("M21").Value & ":I" & ws.Range("N21").Value
End With

  With Target
        If Not Application.Intersect(Target, Range(Na & ", " & Nb & ", " & Nc & ", " & Nd & ", " & Ne & ", " & Nf & ", " & Ng & ", " & Nh & ", " & Ni & ", " & Nj & ", " & Nk & ", " & Nl & ", " & Nm & ", " & Nn & ", " & Nq & ", " & Np & ", " & Nr & ", " & Ns & ", " & Nx & ", " & Nz)) Is Nothing Then
            Cancel = True
            .Value = IIf(.Text = "IN", "OUT", "IN")
            If .Value = "IN" Then
                ' do something
                With .Interior
                    .ColorIndex = 4
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                End With
            Else
                ' do something else
                With .Interior
                    .ColorIndex = 3
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                End With
            End If
            
        End If
    End With
    
    
    Application.ScreenUpdating = True
End Sub

[skywriter]

Maybe this to optimize your second code example from post #6.

Public Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set ws = Sheets("EPB")
Dim x(1 To 20), y As Long

With ws
    For y = 1 To 12
        x(y) = "I" & .Range("M" & y).Value & ":I" & .Range("N" & y).Value
    Next y

    For y = 14 To 21
        x(y - 1) = "I" & .Range("M" & y).Value & ":I" & .Range("N" & y).Value
    Next y
End With
  With Target
        If Not Application.Intersect(Target, Range(Join(x, ","))) Is Nothing Then
            Cancel = True
            .Value = IIf(.Text = "IN", "OUT", "IN")
            If .Value = "IN" Then
                ' do something
                With .Interior
                    .ColorIndex = 4
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                End With
            Else
                ' do something else
                With .Interior
                    .ColorIndex = 3
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                End With
            End If
            
        End If
    End With
    
    
    Application.ScreenUpdating = True
End Sub