Need Help with VBA, True Vs False

[Amped1324]

I am looking to have a range of cells (“H5:H25”) change to match the value of “H4” if it says “Absent” and remain its current data if false. I was able to run code which changes the range to a specified value if false but I am hoping I cane have it leave the cell as is. I also tried using an activex checkbox but still cannot get it to do what I am hoping is possible.

this action will need to be done for approximately 25 different columns. Can someone help me?

[Kenneth Hobs]

Welcome to the forum!

What is "it" in "it says"? Is "it" H4's value="Absent"? Then you want H5:H25 = "Absent"?

[Amped1324]

Welcome to the forum!

What is "it" in "it says"? Is "it" H4's value="Absent"? Then you want H5:H25 = "Absent"?

Yes, sorry about that. I would either select Present or absent via a drop down list or activex check box in H4. If H4 is Present, I’d like h5:h25 to remain as is and not replace with “” or false. If H4 is Absent, I would like “Absent” to replace the value in H5:h25.

[Kenneth Hobs]

Change the range in Intersect to suit. Always test in a backup copy.

Right click the sheet's tab, View Code, and paste.

Private Sub Worksheet_Change(ByVal Target As Range)  
  Dim r As Range, c As Range, calc As Integer
  
  Set r = Intersect(Target, Range("H4:I5"))
  If r Is Nothing Then Exit Sub
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    calc = .Calculation
    .Calculation = xlCalculationManual
  End With
  
  For Each c In r
    If c.Value = "Absent" Then _
      Range(Cells(5, c.Column), Cells(25, c.Column)).Value = "Absent"
  Next c
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = calc
  End With
End Sub

[Amped1324]

Change the range in Intersect to suit. Always test in a backup copy.

Right click the sheet's tab, View Code, and paste.

Private Sub Worksheet_Change(ByVal Target As Range)  
  Dim r As Range, c As Range, calc As Integer
  
  Set r = Intersect(Target, Range("H4:I5"))
  If r Is Nothing Then Exit Sub
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    calc = .Calculation
    .Calculation = xlCalculationManual
  End With
  
  For Each c In r
    If c.Value = "Absent" Then _
      Range(Cells(5, c.Column), Cells(25, c.Column)).Value = "Absent"
  Next c
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = calc
  End With
End Sub

Thank you! That worked as far and changing all cells in the range to "Absent" when H4 was marked as such. Is it possible for me to toggle back to the data as it stood before Absent was in the cell? What I am looking to use this for is to check on a daily basis where coverage is needed for a Team of people who service 18 different clients. If any are out of the office any given day, we will need to see which clients are affected to provide back up coverage. Each team member takes a variation of different clients.

I have other formulas in the worksheet that sum up who is working for each client already so if they are absent one day and here the next, I was hoping to flip back to "Present" and their client assignments would be set back to it was before they were marks as "Absent'. If this is not possible, please let me know. I appreciate your help!!!

[Kenneth Hobs]

There is seldom a need to quote all of a post.

You can always change it to whatever you want. If you mean track each individual cell, that is more involved. You could mirror data to another sheet. If just a set range, I would mirror to another range on the same sheet.

e.g.
A5="x" Z5="x'
A5="Absent" Z5="x"
A5="" Z5="x"
A5="y" Z5="y"

So, set your mirror cell(s) like Z5 in this case, by formula, =IF() for setting the value if A5 <> "" and A5 <> "Absent".

The Change event would then have to be changed to copy back the mirror values if A4 <> "Absent".

Attach a sample workbook once you have it set as you want and still need help. Click Go Advanced button in lower right of a reply. Click paperclip icon on toolbar or Manage Attachments link below reply box to browse and upload XLSM file.

[Amped1324]

Thank you so much! I was able to create a macro to copy the data upon opening the worksheet to a second sheet where I can edit the Absent/Present Values there (I copied the code you gave me to both sheets to get the same outcome. This will work perfect for what I need. I appreciate all your help...This was challenging as it my first time even thinking about Macros and VBA.

Sheet 1:

Private Sub Worksheet_Activate()
  MsgBox ("Make Client Assignments via this Worksheet")
     Worksheets("Split Skills").Range("A1:BB40").Copy Worksheets("Daily Team Coverage Tool").Range("A1:BB40")
    Application.CutCopyMode = False
End SubPrivate Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range, c As Range, calc As Integer
     
    Set r = Intersect(Target, Range("I5:AI6"))
    If r Is Nothing Then Exit Sub
     
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        calc = .Calculation
        .Calculation = xlCalculationManual
    End With
     
    For Each c In r
        If c.Value = "Absent" Then _
        Range(Cells(6, c.Column), Cells(26, c.Column)).Value = "Absent"
    Next c
     
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = calc
    End With
End Sub

Sheet 2:

Private Sub Worksheet_Activate()
  MsgBox ("Manage Daily Absences and Client Coverage Via this Worksheet.")
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range, c As Range, calc As Integer
     
    Set r = Intersect(Target, Range("I5:AI6"))
    If r Is Nothing Then Exit Sub
     
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        calc = .Calculation
        .Calculation = xlCalculationManual
    End With
     
    For Each c In r
        If c.Value = "Absent" Then _
        Range(Cells(6, c.Column), Cells(26, c.Column)).Value = "Absent"
    Next c
     
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = calc
    End With
End Sub