VBA To Loop Not Entire range, but for specific cells(range) excludes some cells

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.

So what are those looped cells in `Horizontally M31:O33, Q31:S33,...repeat total 7 times` and in `Vertically, M31:O33, M35:O37,...repeat 6 times` ? Also, what is the range result (if not is nothing) of this `Set rng = Application.Intersect(Target, Me.Range("M30:AM53"))` ? wouldn't the rng is always a range with one cell (which is the target cell) ? If yes, then what does it mean to loop in rng `For Each cell In rng.Cells` ? — karma, Jan 26 '23 at 08:16

score 0 · Answer 1 · answered Jan 26 '23 at 07:35

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.

Thank you for ur advice. I want modify range;Set rng = Application.Intersect(Target, Me.Range("M30:AM53")) into these non adjacent cells (ranges) like bellow code shape. Sub WriteNumber_v4() Dim rng As Range Dim i, j As Integer For i = 1 To 6 For j = 1 To 7 Set rng = Range("M31:O33").Offset((i - 1) * 4, (j - 1) * 4) 'change 3 to 4 rng.Value = 1 Next j Next i End Sub — Rkw17, Jan 27 '23 at 13:01

VBA To Loop Not Entire range, but for specific cells(range) excludes some cells

1 Answers1