Click check box and fill range of cells with RED

[lockarde]

Good morning all,

I have a workbook that tracks ongoing jobs. I have a sheet for each month that tracks jobs requested during that time period. There are times when a job gets put on hold, and I'd like to have an "On Hold" checkbox that when I click it, it sets the fill color of the range of cells associated with that job to turn red. I have some basic code written, but am getting Subscript out of range error.

Sub Hold1_Click()

    With Sheet9
    Range("A4,T6").Interior.ColorIndex = RGB(255, 0, 0)
    End With

End Sub

This is sort of just a proof of concept, the range "A4:T6" is typically the range size of one job, however, sometimes there are extra rows included in the range due to extra "Notes". So ideally, I would have a checkbox next to each job, and it'd be able to find the end of the job, and color the range red (with the inverse being true as well, once a job is no longer on hold, unchecking the box would revert the format back to its original state). Some jobs have 3 or 4 rows of "notes", typically jobs only have 1 row of notes.

A typical job looks like the following:

Any help is greatly appreciated!

 

[Fluff]

Thanks for that, how about

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Dim Rng As Range
   If Not Intersect(Target, Range("A4:A100")) Is Nothing Then
      If Target.Value Like "Item *" Then
         Set Rng = Intersect(Range(Target, Target.End(xlDown)).EntireRow, Range("A:T"))
         If Target.Interior.Color = vbRed Then
            Rng.Interior.Color = xlNone
            Rng.Columns(1).Interior.Color = 14277081
         Else
            Rng.Interior.Color = vbRed
         End If
      End If
      Cancel = True
   End If
End Sub

This needs to go in the sheet9 code module, then just doubleclick any cell that has "Item #"

 

[lockarde]

You've done it again Fluff! I can't thank you enough, works like a charm! One question though - if I wanted this to apply to not just Sheet9, but to any active sheet, I'd put it in the Workbook module, and add a With "active sheet", followed by the code?

 

[Fluff]

No need to change any of the code, just move it to the ThisWorkbook module and make it a Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)event

 

[lockarde]

No need to change any of the code, just move it to the ThisWorkbook module and make it a Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)event

Beautiful! I really appreciate the help Fluff! I have some other features I would like to add, but they don't really apply to the specific topic of this post. Should I make a new post, or reply here?

 

[Fluff]

Sounds like a new thread, cheers ?

 

[lockarde]

Sounds like a new thread, cheers ?

Will do!

 

[lockarde]

Thanks for that, how about

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Dim Rng As Range
   If Not Intersect(Target, Range("A4:A100")) Is Nothing Then
      If Target.Value Like "Item *" Then
         Set Rng = Intersect(Range(Target, Target.End(xlDown)).EntireRow, Range("A:T"))
         If Target.Interior.Color = vbRed Then
            Rng.Interior.Color = xlNone
            Rng.Columns(1).Interior.Color = 14277081
         Else
            Rng.Interior.Color = vbRed
         End If
      End If
      Cancel = True
   End If
End Sub

This needs to go in the sheet9 code module, then just doubleclick any cell that has "Item #"

Hey Fluff, Can you explain what part of this acts on the "double click" ? I'd like to replicate this action to initiate some other functions I've implemented on my sheet. Thanks in advance!

 

[Fluff]

That code will automatically trigger whenever you double-click any cell on that sheet, but this line

If Not Intersect(Target, Range("A4:A100")) Is Nothing Then

Checks if the Target (the cell that was double-clicked) is in the range A4:A100, if it is the code runs, otherwise it skips to the final End If & exits

 

[lockarde]

That code will automatically trigger whenever you double-click any cell on that sheet, but this line

If Not Intersect(Target, Range("A4:A100")) Is Nothing Then

Checks if the Target (the cell that was double-clicked) is in the range A4:A100, if it is the code runs, otherwise it skips to the final End If & exits

Ok, I'm probably missing something key... I tried to emulate what I thought was relative to this action, and apply to to my other Sub, but I can't get it to run by Double-Click. My code is below:

Private Sub NewMonth(ByVal Target As Range)
Application.ScreenUpdating = False
Dim mFormat1$, mFormat2$, msb$, msa$, msa2 As Byte
Dim nws As Worksheet, ms_new$
Dim mos As Integer, curdate As Double, moscheck As Integer, yearcheck As Integer, mostart As String

If Not Intersect(Target, Range("T1")) Is Nothing Then
    If Target.Value Like "Next Month" Then
        curdate = Date
        moscheck = Month(curdate)
        yearcheck = year(curdate)
        
        mostart = Date - Day(Date) + 1
        
        msb = ActiveSheet.Name
        msa = Replace(msb, " ", ""): msa = Left(msa, InStr(msa, ".") - 1)
        msa2 = CByte(msa): msa2 = msa2 + 1
        mFormat1 = "1"
        
        mos = DateSerial(yearcheck, moscheck + 1, 1) - DateSerial(yearcheck, moscheck, 1)
        
        mFormat2 = mos
        
        ms_new = CStr(msa2) & Chr(46) & mFormat1 & Chr(32) & Chr(45) & Chr(32) & CStr(msa2) & Chr(46) & mFormat2
        Set nws = Sheets.Add(after:=Sheets(Sheets.Count)): nws.Name = ms_new
        
        Sheets(msb).Range("A1:T6").Copy: Sheets(ms_new).Range("A1").PasteSpecial Paste:=8, Operation:=xlNone
        Sheets(ms_new).Range("A1").PasteSpecial Paste:=-4104, Operation:=xlNone
        [C2].Select
        With Sheets(ms_new)
            .Range("v8").Value = curdate
            .Range("B5:T6").ClearContents
            .Columns("V").Hidden = True
        End With
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End If
End If
End Sub

The idea is I can create a new sheet by double clicking on T1 that simply says "Next Month". I apologize, I know this is straying from the OP, but I wasn't sure how else to reference what I needed in the code you helped me with last week.

 

[Fluff]

You cannot rename the sub, it has to be

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

otherwise VBA just thinks it's a normal macro, rather than an Event.