AutoFill Macro Stops working after a short tim

S

Ski11Racr

New Member
Joined
Nov 10, 2022
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Hello,

Maybe you all can help. I have a macro that formats cells to fill a certain color once a selection is made from a dropdown list. The problem is that it stops running after row 76 (see picture). The range I have set should easily fill the entire field. I can't seem to see the error. Any help would be great. I have included the code below:

Sub PTFormatting2()
'
' PTFormatting2 Macro
'

'
Range("C2:F2000").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$G2=""Defer"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599963377788629
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$G2=""Received"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599963377788629
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$G2=""Actioned"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.799981688894314
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$G2=""OHC Needed"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.599963377788629
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$G2=""SIA/FR Needed"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 16751052
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$G2=""SIA/FR Submitted"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599963377788629
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
 

Attachments

  • Example.png
    Example.png
    15.6 KB · Views: 5

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Sort by date Sort by votes
Maybe helps you...

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("G2:G" & Cells(Rows.Count, 2).End(xlUp).Row)) Is Nothing Then Exit Sub
    Select Case Target.Value
        Case "Defer"
            Range("B" & Target.Row & ":F" & Target.Row).Interior.Color = RGB(189, 216, 237)
        Case "Received"
            Range("B" & Target.Row & ":F" & Target.Row).Interior.Color = RGB(255, 153, 0)
        Case "Actioned"
            Range("B" & Target.Row & ":F" & Target.Row).Interior.Color = RGB(255, 255, 0)
        Case "OHC Needed"
            Range("B" & Target.Row & ":F" & Target.Row).Interior.Color = RGB(239, 228, 176)
        Case "SIA/FR Needed"
            Range("B" & Target.Row & ":F" & Target.Row).Interior.Color = RGB(200, 191, 231)
        Case "SIA/FR Submitted"
            Range("B" & Target.Row & ":F" & Target.Row).Interior.Color = RGB(202, 156, 253)
    End Select
End Sub
 
Upvote 0
Flaiban said:
Maybe helps you...

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("G2:G" & Cells(Rows.Count, 2).End(xlUp).Row)) Is Nothing Then Exit Sub
    Select Case Target.Value
        Case "Defer"
            Range("B" & Target.Row & ":F" & Target.Row).Interior.Color = RGB(189, 216, 237)
        Case "Received"
            Range("B" & Target.Row & ":F" & Target.Row).Interior.Color = RGB(255, 153, 0)
        Case "Actioned"
            Range("B" & Target.Row & ":F" & Target.Row).Interior.Color = RGB(255, 255, 0)
        Case "OHC Needed"
            Range("B" & Target.Row & ":F" & Target.Row).Interior.Color = RGB(239, 228, 176)
        Case "SIA/FR Needed"
            Range("B" & Target.Row & ":F" & Target.Row).Interior.Color = RGB(200, 191, 231)
        Case "SIA/FR Submitted"
            Range("B" & Target.Row & ":F" & Target.Row).Interior.Color = RGB(202, 156, 253)
    End Select
End Sub
Click to expand...
Thank you for the suggestion. I tried using this and I'm getting an Object required error for the line "If Intersect(Target,Range..." Any thoughts? Please forgive me as I'm relatively new to using macros.
 
Upvote 0
Ski11Racr said:
Thank you for the suggestion. I tried using this and I'm getting an Object requir
VBA Code: 
[CODE=vba]
[/Ced error for the line "If Intersect(Target,Range..." Any thoughts? Please forgive me as I'm relatively new to using macros.
Click to expand...
Lets go... the procedure I gave you is not to insert it into the module, replacing your previous one.
This is to double click on the worksheet, and paste this code.
However, if you did just that, change this:
VBA Code: 
If Intersect(Target, Range("G2:G" & Cells(Rows.Count, 2).End(xlUp).Row)) Is Nothing Then Exit Sub

For this

If Intersect(Target, Range("G2:G1000") Is Nothing Then Exit Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
Variable losing set Range
Replies
8
Views
82
MARK858
MARK858
tezza
  • Question
VBA conditional order issue
Replies
6
Views
455
kevin9999
K
W
  • Solved
VBA Apply Formatting Based on 2 Criteria and If Another Cell Contains...
2
Replies
13
Views
278
Joe4
Joe4
P
  • Solved
Loop Not Looping too Next Sheet
Replies
3
Views
249
Joe4
Joe4
N
  • Question
My code is suddenly really slow
Replies
1
Views
151
RobP
R

Forum statistics

Threads
1,215,245
Messages
6,123,842
Members
449,129
Latest member
krishnamadison

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