CODEWITHSUNDEEP
excelvba
Lawrence Forster
Lawrence Forster

Reputation: 53

Looping through cells to identify if Data validation list selected

I have a macro that changes the colour of the cell (Offset(0,1)) if the cell to the left says delivered and the offset cell is blank. The macro is triggered by a change in the data validation list. See below. However, the code doesn't do as i want. It doesn't run every time the data validation list is selceted. I want this to run every time a data validation option is changed within Column W. (Validation list applies to all cells in column W).

The code works but its the way I am running the macro within a worksheet change.

The macro itself 

Sub ConditionalFormatSharepointDeliveryLink()

Dim Lastrow As Long, n As Long, cell As Range, ws As Worksheet
Lastrow = Sheets("Sub Tasks").Range("W" & Rows.Count).End(xlUp).Row

n = 4

    For Each cell In Worksheets("Sub Tasks").Range("W4:W" & Lastrow)
        If cell.value = "Delivered" And cell.Offset(0, 1).value = "" Then
            cell.Offset(0, 1).Interior.Color = vbRed
        End If
    n = n + 1
    Next cell

End Sub

How i am calling the macro

Private Sub Worksheet_Change(ByVal Target As Range)


Dim Lastrow As Long, n As Long, cell As Range, ws As Worksheet
Lastrow = Sheets("Sub Tasks").Range("W" & Rows.Count).End(xlUp).Row

For Each cell In Worksheets("Sub Tasks").Range("W4:4" & Lastrow)
    If Target.Address(True, True) = cell Then
        Select Case Target
            Case "Delivered"
                Call ConditionalFormatSharepointDeliveryLink
        End Select
    End If

End Sub
``````````````````````````` 




[![enter image description here][1]][1]


  [1]: https://i.sstatic.net/BJzZB.png

Upvotes: 0

Views: 39

Answers (2)

Plutian
Plutian

Reputation: 2309

This can be done entirely without a loop like so:

Private Sub Worksheet_Change(ByVal Target As Range)
lastrow = Sheets("Sub Tasks").Range("W" & Rows.Count).End(xlUp).Row
If Target.Value = "Delivered" Then
    If Application.Intersect(Target, Range("W4:W" & lastrow)) Is Nothing Then     Exit Sub
    Call ConditionalFormatSharepointDeliveryLink
End If
End Sub

As per your comments on the other answer, you might want to change this sub to Worksheet_Change instead. That will run when a cell is changed to "Delivered", but the above only runs when a new cell is selected with "Delivered" in the name.

Upvotes: 0

SJR
SJR

Reputation: 23081

I don't see a need for the second sub (but have left in in case you want to retain for other purposes, though you should add a range argument).

Check the intersection between Target and column W and then only run the code if there is something (plenty on this online).

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Lastrow As Long, cell As Range
Lastrow = Sheets("Sub Tasks").Range("W" & Rows.Count).End(xlUp).Row

If Not Intersect(Target, Range("W4:W" & Lastrow)) Is Nothing Then
    For Each cell In Intersect(Target, Range("W4:W" & Lastrow))
        If cell.Value = "Delivered" And cell.Offset(0, 1).Value = vbNullString Then
            cell.Offset(0, 1).Interior.Color = vbRed
            'ConditionalFormatSharepointDeliveryLink
        End If
    Next cell
End If

End Sub

Note that you could do all this using conditional formatting.

enter image description here

Upvotes: 2

Related Questions