Simple Function w/o using VBA

[Bryancarlo]

Hi,
Is there a way to apply simple "if" or any other function without using VBA. Im trying to have this kind of outcome:
1. When I highlight a cell yellow in cols C,D,E,F,H,I,J,K, the time (ex.12pm-8pm) and date will automatically show in columns M and N (without using the update button)
2. When I highlight a cell yellow and put the name "Nicole", it would still copy and paste the time and date to columns M and N but will also show in cols O and P under "Nicole".

Hoping for your assistance.

Thank you

 

[Eric W]

Formulas cannot detect a cell's formatting, only the contents, so no, a formula can't do what you want. Even VBA would have problems, since there is no Event that detects a format change. About the only way I see you could do it is by using VBA to adapt the cell context menu (what you see when you right click a cell) and add an entry that says "Highlight Yellow and update dates". Then you could right click the cell, select that entry, and everything happens as you'd like. But it's still VBA. Let me know if you're interested in that.

 

[Bryancarlo]

Formulas cannot detect a cell's formatting, only the contents, so no, a formula can't do what you want. Even VBA would have problems, since there is no Event that detects a format change. About the only way I see you could do it is by using VBA to adapt the cell context menu (what you see when you right click a cell) and add an entry that says "Highlight Yellow and update dates". Then you could right click the cell, select that entry, and everything happens as you'd like. But it's still VBA. Let me know if you're interested in that.

yes please.. need all the help I can get.. Thank you

 

[Eric W]

OK, here's a first draft. Open a COPY of your workbook. Press Alt-F11 to open the VBA editor. On the left side navigation tree, double click on the ThisWorkbook item:

Paste the following code into the window that opens:

Private Sub Workbook_Deactivate()
    On Error Resume Next
        Application.CommandBars("Cell").Reset       ' When exiting, reset the menu
    On Error GoTo 0
End Sub
 
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim cmdBtn As CommandBarButton, cntl As Variant
    
    On Error Resume Next
        Application.CommandBars("Cell").Reset       ' Reset the menu
        
' These lines limit the menu changes to a specific sheet and range
        If ActiveSheet.Name <> "Scheduling" Then Exit Sub                       ' Right sheet?
        If InStr("CDEFHIJK", Left(Target.Address(0, 0), 1)) = 0 Then Exit Sub   ' Right columns?
        If Target.Row < 3 Or Target.Row > 34 Then Exit Sub                      ' Right rows?
        
        With Application.CommandBars("Cell").Controls.Add(Temporary:=True, before:=1)
           .Caption = "Mark Shift Available"                                    ' Caption description
           .Style = msoButtonCaption
           .OnAction = "AddShift"                                               ' Macro to call
        End With

    On Error GoTo 0
End Sub

Change the sheet name about halfway down to match your workbook. (I called the sheet "Scheduling", I'm sure you have a different name.) Next press Alt-IM to Insert a Module. Paste the following code into that window:

Public Function AddShift()
Dim r As Long, c As Long

    ActiveCell.Interior.Color = vbYellow
    r = Range("M1000").End(xlUp).Row + 1
    Cells(r, "M") = Format(Cells(ActiveCell.Row, "B"), "dddd, d mmmm yyyy")
    c = IIf(ActiveCell.Column < 7, 3, 8)
    Cells(r, "N") = Cells(2, ActiveCell.Column) & " " & Cells(1, c)
    
End Function

Now close the VBA editor, go back to Excel, and right-click one of the cells in the right range. You should see "Mark Shift Available" at the top of the menu. Select it, and the cell should turn yellow, and the data is entered in the next available row in the M:N columns.

As far as Nicole, I'm a bit confused as to what you want. The list in the O:P column seems to be all of the dates Nicole is scheduled. Did you manually enter those, or does the "Update" button do that? You could have an Event routine to do that automatically when you enter Nicole in the C:K columns. But however you get her dates in the O:P columns, what do you want to do if you right click a cell with Nicole in it? Delete the data from the O:P column? Leave it there and highlight it yellow?

Let me know!

 

[Bryancarlo]

OK, here's a first draft. Open a COPY of your workbook. Press Alt-F11 to open the VBA editor. On the left side navigation tree, double click on the ThisWorkbook item:

View attachment 93121

Paste the following code into the window that opens:

Private Sub Workbook_Deactivate()
    On Error Resume Next
        Application.CommandBars("Cell").Reset       ' When exiting, reset the menu
    On Error GoTo 0
End Sub
 
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim cmdBtn As CommandBarButton, cntl As Variant
   
    On Error Resume Next
        Application.CommandBars("Cell").Reset       ' Reset the menu
       
' These lines limit the menu changes to a specific sheet and range
        If ActiveSheet.Name <> "Scheduling" Then Exit Sub                       ' Right sheet?
        If InStr("CDEFHIJK", Left(Target.Address(0, 0), 1)) = 0 Then Exit Sub   ' Right columns?
        If Target.Row < 3 Or Target.Row > 34 Then Exit Sub                      ' Right rows?
       
        With Application.CommandBars("Cell").Controls.Add(Temporary:=True, before:=1)
           .Caption = "Mark Shift Available"                                    ' Caption description
           .Style = msoButtonCaption
           .OnAction = "AddShift"                                               ' Macro to call
        End With

    On Error GoTo 0
End Sub

Change the sheet name about halfway down to match your workbook. (I called the sheet "Scheduling", I'm sure you have a different name.) Next press Alt-IM to Insert a Module. Paste the following code into that window:

Public Function AddShift()
Dim r As Long, c As Long

    ActiveCell.Interior.Color = vbYellow
    r = Range("M1000").End(xlUp).Row + 1
    Cells(r, "M") = Format(Cells(ActiveCell.Row, "B"), "dddd, d mmmm yyyy")
    c = IIf(ActiveCell.Column < 7, 3, 8)
    Cells(r, "N") = Cells(2, ActiveCell.Column) & " " & Cells(1, c)
   
End Function

Now close the VBA editor, go back to Excel, and right-click one of the cells in the right range. You should see "Mark Shift Available" at the top of the menu. Select it, and the cell should turn yellow, and the data is entered in the next available row in the M:N columns.

As far as Nicole, I'm a bit confused as to what you want. The list in the O:P column seems to be all of the dates Nicole is scheduled. Did you manually enter those, or does the "Update" button do that? You could have an Event routine to do that automatically when you enter Nicole in the C:K columns. But however you get her dates in the O:P columns, what do you want to do if you right click a cell with Nicole in it? Delete the data from the O:P column? Leave it there and highlight it yellow?

Let me know!

Thanks for this boss. In addition, if I make changes or remove a highlighted cell, how can we remove it from the Open Available Shifts? The codes above only add the open shift but not removing them if I delete or change a highlighted cell. For Nicole, if I put her name in the highlighted cell, the shift still adds in Open Available Shifts but at the same time saves on the "Nicole" column.

 

[Eric W]

OK, replace the code on the ThisWorkbook tab with this:

Private Sub Workbook_Deactivate()
    On Error Resume Next
        Application.CommandBars("Cell").Reset       ' When exiting, reset the menu
    On Error GoTo 0
End Sub
 
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim cmdBtn As CommandBarButton, cntl As Variant
   
    On Error Resume Next
        Application.CommandBars("Cell").Reset       ' Reset the menu
       
' These lines limit the menu changes to a specific sheet and range
        If ActiveSheet.Name <> "Scheduling" Then Exit Sub                       ' Right sheet?
        If InStr("CDEFHIJK", Left(Target.Address(0, 0), 1)) = 0 Then Exit Sub   ' Right columns?
        If Target.Row < 3 Or Target.Row > 34 Then Exit Sub                      ' Right rows?
       
        With Application.CommandBars("Cell").Controls.Add(Temporary:=True, before:=1)
           .Caption = "Mark Shift Available"                                    ' Caption description
           .Style = msoButtonCaption
           .OnAction = "AddShift"                                               ' Macro to call
        End With
        With Application.CommandBars("Cell").Controls.Add(Temporary:=True, before:=2)
           .Caption = "Shift Not Available"
           .Style = msoButtonCaption
           .OnAction = "DelShift"
        End With

    On Error GoTo 0
End Sub

It's pretty much the same, but it adds the "Shift Not Available" Control. Feel free to change the caption text if you want.

Now go to the Module1 tab and replace that code with this:

Public Function AddShift()
Dim r As Long, c As Long

    ActiveCell.Interior.Color = vbYellow
    r = Range("M1000").End(xlUp).Row + 1
    Cells(r, "M") = Format(Cells(ActiveCell.Row, "B"), "dddd, d mmmm yyyy")
    c = IIf(ActiveCell.Column < 7, 3, 8)
    Cells(r, "N") = Cells(2, ActiveCell.Column) & " " & Cells(1, c)
   
End Function


Public Function DelShift()
Dim lr As Long, r As Long, c As Long, i As Long

    ActiveCell.Interior.Color = xlNone
   
    lr = Range("M1000").End(xlUp).Row
    t1 = Format(Cells(ActiveCell.Row, "B"), "dddd, d mmmm yyyy")
    c = IIf(ActiveCell.Column < 7, 3, 8)
    t2 = Cells(2, ActiveCell.Column) & " " & Cells(1, c)
   
    For r = lr To 3 Step -1
        If Cells(r, "M") = t1 And Cells(r, "N") = t2 Then
            Range("M" & r & ":N" & r).Value = Range("M" & lr & ":N" & lr).Value
            Range("M" & lr & ":N" & lr).ClearContents
            Exit Function
        End If
    Next r
   
End Function

The AddShift function has not changed, but I added the DelShift function to remove a shift. To make sure there are no gaps in the list, I put the last entry into the row where I deleted the shift. We could sort it or something if you want, but then we'd need to put the actual date in the M column, and format it so it looks like it does now.

Finally, while still in the VBA editor double click on the Sheet1 tab (or whichever tab has your tables on it), and paste this code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long, c As Long

    If InStr("CDEFHIJK", Left(Target.Address(0, 0), 1)) = 0 Then Exit Sub   ' Right columns?
    If Target.Row < 3 Or Target.Row > 34 Then Exit Sub                      ' Right rows?
               
    If Target.Interior.Color <> vbYellow Then Exit Sub      ' This only works for yellow cells
    If Target.Value <> "Nicole" Then Exit Sub               ' This only works for "Nicole" cells
       
       
    r = Range("P1000").End(xlUp).Row + 1                    ' Find last row in P column
    If r < 3 Then r = 3                                     ' Must be at least row 3
       
    Cells(r, "O").Value = Cells(Target.Row, "B").Value      ' Move the date from column B to O
    c = IIf(ActiveCell.Column < 7, 3, 8)                    ' Find the address column
    Cells(r, "P") = Cells(2, Target.Column) & " " & Cells(1, c) ' Move the time and place
       
End Sub

If I understand correctly, you will use the Add Shift button to turn the cell yellow and add the shift to the M:N columns. Then if you type "Nicole" in the same cell, it will add the shift to the O:P columns. (If you remove the line with vbYellow in it, it will add the shift to the O:P columns no matter what color the cell is.)

Let me know how this works!