VBA 循环不是整个范围，但对于特定单元格（范围）不包括某些单元格

Question

I wrote below code. It works, however, I want to modify this line

Set rng = Application.Intersect(Target, Me.Range("M30:AM53")) If Not rng Is Nothing Then 'only loop though any cells in M30:AM53

To not entire renge(M30:AM53) but to specific range. Horizontally M31:O33, Q31:S33,...repeat total 7 times. Vertically, M31:O33, M35:O37,...repeat 6 times.

Any advice and suggestions would be appreciated.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim trlRed As Long, oPhoneBlue As Long, adrGreen As Long, iosGrey As Long, cmnPurple As Long
    Dim rng As Range, cell As Range

    trlRed = RGB(230, 37, 30)
    oPhoneBlue = RGB(126, 199, 216)
    adrGreen = RGB(61, 220, 132)
    iosGrey = RGB(162, 170, 173)
    cmnPurple = RGB(165, 154, 202)

    'firstLvValFor = Array("TRIAL", "BEGINNER", "NOVICE", "INTERMEDIATE", "ADVANCED")
    secondLvValFor = Array("aaa", "bbb", "ccc", "ddd")

    thirdLvValFor_01 = Array("Basic", "Text", "PhoneCall", "mail", "camera")
    thirLvValFor_02 = Array("Security", "WhatsApp", "Wi-Fi")
    

    Set rng = Application.Intersect(Target, Me.Range("M30:AM53"))
    If Not rng Is Nothing Then 'only loop though any cells in M30:AM53
        For Each cell In rng.Cells
            If cell.Value = "Session" And cell.Offset(0, -2).Value = "TRIAL" Then
                cell.Offset(0, -2).Resize(1, 3).Interior.Color = trlRed

            ElseIf IsError(Application.Match(cell.Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value = "aaa" And cell.Offset(0, -2).Value <> "TRIAL" Then
                cell.Offset(0, -2).Resize(1, 3).Interior.Color = oPhoneBlue

            ElseIf cell.Value = "aaa" And IsError(Application.Match(cell.Offset(0, 1).Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value <> "TRIAL" Then
                cell.Offset(0, -1).Resize(1, 3).Interior.Color = oPhoneBlue


            ElseIf IsError(Application.Match(cell.Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value = "bbb" And cell.Offset(0, -2).Value <> "TRIAL" Then
                cell.Offset(0, -2).Resize(1, 3).Interior.Color = adrGreen

            ElseIf cell.Value = "bbb" And IsError(Application.Match(cell.Offset(0, 1).Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value <> "TRIAL" Then
                cell.Offset(0, -1).Resize(1, 3).Interior.Color = adrGreen ' I mistook following code cell.offset(0, 1) = value, this was wrong. The correct form is offset(0, 1).value. This works perfectly. 01/23/23 14:08


            ElseIf IsError(Application.Match(cell.Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value = "ccc" And cell.Offset(0, -2).Value <> "TRIAL" Then
                cell.Offset(0, -2).Resize(1, 3).Interior.Color = iosGrey

            ElseIf cell.Value = "ccc" And IsError(Application.Match(cell.Offset(0, 1).Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value <> "TRIAL" Then
                cell.Offset(0, -1).Resize(1, 3).Interior.Color = iosGrey


            ElseIf IsError(Application.Match(cell.Value, thirLvValFor_02, 0)) = False And cell.Offset(0, -1).Value = "ddd" And cell.Offset(0, -2).Value <> "TRIAL" Then
                cell.Offset(0, -2).Resize(1, 3).Interior.Color = cmnPurple

            ElseIf cell.Value = "ddd" And IsError(Application.Match(cell.Offset(0, 1).Value, thirLvValFor_02, 0)) = False And cell.Offset(0, -1).Value <> "TRIAL" Then
                cell.Offset(0, -1).Resize(1, 3).Interior.Color = cmnPurple



            Else
                cell.Interior.ColorIndex = xlColorIndexNone
            End If
        Next cell
    End If
End Sub

To get locking some cells while code is running, I have to modify range more precisely. Inside the range(M30:AM53), I want to apply functions to non adjacent cells(range) regularly. In this case, 1 cell above, 1 cell below, 1 cell right should be excluded. I appreciate you all in advance.

Answer 1

The below function removes certain cells from a range, but keeps the rest of the range.

Function ExceptRange(Rng As Range, Except As Range) As Range
Dim a As Long, Confirmed() As Range
For a = 1 To Rng.Cells.Count
    If Intersect(Rng.Cells(a), Except) Is Nothing Then
        If ExceptRange Is Nothing Then
            Set ExceptRange = Rng.Cells(a)
        Else
            Set ExceptRange = Union(ExceptRange, Rng.Cells(a))
        End If
    End If
Next
End Function

If you call this in your sub, you can remove unwanted cells from your rng before the loop, so For Each cell in Rng automatically will skip the cells you've removed.