Have to reselect cell to get macro to finish tasks.

S

SS Rookie

New Member
Joined
Apr 14, 2023
Messages
8
Office Version
  1. 2016
Platform
  1. Windows
When a cell with a drop down list changes values, my macro performs actions depending on the value the drop down cell is changed too. The macro works except to get it to finish or change the color of a cell you have to click off the drop down cell and then reselect it. Is there something I need to add to the code to get the color to change at the same time it is doing the strikethrough? Copy of the If statement below.

If rngCurrent.Value = rngValue.Value Then
Range("B" & rngCurrent.Row & ":Q" & rngCurrent.Row).Font.Strikethrough = True
Range("M" & rngCurrent.Row).Interior.Color = Range("L" & rngCurrent.Row).Interior.Color
Else
Range("B" & rngCurrent.Row & ":Q" & rngCurrent.Row).Font.Strikethrough = False
Range("M" & rngCurrent.Row).Interior.ColorIndex = 4
'Exit Sub
End If
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
Could you provide your entire code (not just a part of it) and also, do you have 2 different worksheet events on the same sheet, a Change and a SelectionChange?
 
Upvote 0
I only have Selection Change in the drop down. Can you have both? How do you do that?

Here's the full code.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Left(Target.Address, 2) = "$L" Then 'Locate Column
Dim rngCurrent As Range 'Define varible
Dim rngValue As Range
Dim cellStat As Range

Set rngCurrent = ActiveCell

Set rngValue = Range("AI6")
Set cellStat = Range("AI5")

If rngCurrent.Value = rngValue.Value Then
Range("B" & rngCurrent.Row & ":Q" & rngCurrent.Row).Font.Strikethrough = True
'Range("M" & rngCurrent.Row).Interior.Color = Range("L" & rngCurrent.Row).Interior.Color
Else
Range("B" & rngCurrent.Row & ":Q" & rngCurrent.Row).Font.Strikethrough = False
'Range("M" & rngCurrent.Row).Interior.ColorIndex = 4

End If

If rngCurrent.Value = cellStat.Value Then
Range("M" & rngCurrent.Row).Interior.ColorIndex = 4
Else
Range("M" & rngCurrent.Row).Interior.Color = Range("L" & rngCurrent.Row).Interior.Color

End If
End If

End Sub
 
Upvote 0
kevin9999 said:
Could you provide your entire code (not just a part of it) and also, do you have 2 different worksheet events on the same sheet, a Change and a SelectionChange?
Click to expand...
I only have Selection Change in the drop down. Can you have both? How do you do that?

Here's the full code.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Left(Target.Address, 2) = "$L" Then 'Locate Column
Dim rngCurrent As Range 'Define varible
Dim rngValue As Range
Dim cellStat As Range

Set rngCurrent = ActiveCell

Set rngValue = Range("AI6")
Set cellStat = Range("AI5")

If rngCurrent.Value = rngValue.Value Then
Range("B" & rngCurrent.Row & ":Q" & rngCurrent.Row).Font.Strikethrough = True
'Range("M" & rngCurrent.Row).Interior.Color = Range("L" & rngCurrent.Row).Interior.Color
Else
Range("B" & rngCurrent.Row & ":Q" & rngCurrent.Row).Font.Strikethrough = False
'Range("M" & rngCurrent.Row).Interior.ColorIndex = 4

End If

If rngCurrent.Value = cellStat.Value Then
Range("M" & rngCurrent.Row).Interior.ColorIndex = 4
Else
Range("M" & rngCurrent.Row).Interior.Color = Range("L" & rngCurrent.Row).Interior.Color

End If
End If

End Sub
 
Upvote 0
SS Rookie said:
Is there something I need to add to the code to get the color to change at the same time it is doing the strikethrough?
Click to expand...
At the moment, your code is commenting out the lines that affect the color. Start by deleting the single quote at the start of those 2 lines.
Rich (BB code): 
'Range("M" & rngCurrent.Row).Interior.Color = Range("L" & rngCurrent.Row).Interior.Color

Rich (BB code): 
'Range("M" & rngCurrent.Row).Interior.ColorIndex = 4
 
Upvote 0
kevin9999 said:
At the moment, your code is commenting out the lines that affect the color. Start by deleting the single quote at the start of those 2 lines.
Rich (BB code): 
'Range("M" & rngCurrent.Row).Interior.Color = Range("L" & rngCurrent.Row).Interior.Color

Rich (BB code): 
'Range("M" & rngCurrent.Row).Interior.ColorIndex = 4
Click to expand...
They are commented out since I tried that also but didn't have any different results in how the macro ran.
 
Upvote 0
See if this works any better for you.
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("L:L"), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        
        If Target.Value = Range("A16").Value Then
            Range("B" & Target.Row & ":Q" & Target.Row).Font.Strikethrough = True
            Range("M" & Target.Row).Interior.Color = Range("L" & Target.Row).Interior.Color
        Else
            Range("B" & Target.Row & ":Q" & Target.Row).Font.Strikethrough = False
            Range("M" & Target.Row).Interior.ColorIndex = 4
        End If
        
        If Target.Value = Range("A15").Value Then
            Range("M" & Target.Row).Interior.ColorIndex = 4
        Else
            Range("M" & Target.Row).Interior.Color = Range("L" & Target.Row).Interior.Color
        End If
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
 
Upvote 0
kevin9999 said:
See if this works any better for you.
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("L:L"), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
       
        If Target.Value = Range("A16").Value Then
            Range("B" & Target.Row & ":Q" & Target.Row).Font.Strikethrough = True
            Range("M" & Target.Row).Interior.Color = Range("L" & Target.Row).Interior.Color
        Else
            Range("B" & Target.Row & ":Q" & Target.Row).Font.Strikethrough = False
            Range("M" & Target.Row).Interior.ColorIndex = 4
        End If
       
        If Target.Value = Range("A15").Value Then
            Range("M" & Target.Row).Interior.ColorIndex = 4
        Else
            Range("M" & Target.Row).Interior.Color = Range("L" & Target.Row).Interior.Color
        End If
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
Click to expand...
It's doing multiple things at once now, but not doing what I'm going for. The code you provided immediately performs the strikethrough and color change upon making the drop-down cell active, and then removes the strikethrough when the "A15" value is chosen but if the drop-down choices are toggled through they don't consistently perform as they should. ie. If the "A16" value is chosen and the strikethrough appears but the cell color stays as indicated for the "A15" value also while the cell has the "A16" value present if that cell is chosen again as the active cell even by simply using the arrow keys to move through the sheet the strikethrough goes away.
 
Upvote 0
Yes, I did struggle with the logic of the original code a bit. What you want is easily fixed but I'm away from my usual laptop right now. In the meantime, could you clarify precisely what should happen when the following happens:
Target cell = A15 - what happens with strikethrough & color
Target cell = A16 - what happens with strikethrough & color
Target cell matches neither A15 or A16 - what happens with strikethrough & color

I'll get back to you once you respond & I'm back at home
Cheers
 
Upvote 0
Try this version (I think I get what you're looking for)

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("L:L"), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        
        Select Case Target.Value
            Case Is = Range("A16").Value
                Range("B" & Target.Row & ":Q" & Target.Row).Font.Strikethrough = True
                Range("M" & Target.Row).Interior.Color = Range("L" & Target.Row).Interior.Color
            Case Is = Range("A15").Value
                Range("B" & Target.Row & ":Q" & Target.Row).Font.Strikethrough = False
                Range("M" & Target.Row).Interior.ColorIndex = 4
            Case Else
                '???
        End Select
    End If
    
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Hide Rows based on cell with drop down values
Replies
1
Views
422
kevin9999
K
B
  • Solved
Getting Macros to run automatically
Replies
3
Views
208
mumps
mumps
G
  • Solved
Format & Protect range of cells using VBA
Replies
7
Views
288
Gajendran Yadhav
G
S
  • Question
Worksheet Change Event
Replies
2
Views
378
sspatriots
S
B
  • Solved
Run macro when drop-down value changes
Replies
3
Views
807
Joe4
Joe4

Forum statistics

Threads
1,214,965
Messages
6,122,496
Members
449,089
Latest member
Raviguru

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top