5 Buttons to fill active cell with a certain color and a certain letter

harveya915

Board Regular
Joined
Sep 4, 2015
Messages
101
I created an employee attendance record sheet. The months are on the top row and the days (1-31) are on the left column. What I want to do is when I double-click a cell (example B2 for Jan. 1) it will bring up a UserForm with 5 buttons, click on one of the buttons in the UserForm to fill that selected cell with a certain color (example: yellow) and insert a letter (example: L ) in to that cell.

The first button would be to fill in the cell with color "Yellow" and the letter "L"
The second button would be to fill in the cell with color "Blue" and letter "P"
The third button would be to fill in the cell with color "Pink" and letter "S"
Fourth button fill color "Red" letter "X"
Fifth Button fill color "Green" letter "V"

Please bare with me as I'm still rather new at this with little to no experience at all, but I appreciate the help!
 

Some videos you may like

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
1,089
Your previous threads show that you have some experience with VBA, what exactly do you need help with?
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
consider simpler approach unless there is something you have not mentioned
- use data validation dropdown to allow only vaid values L, P S, X, V to be entered
- the range could be colour filled using 5 very simple conditional formatting rules
- VBA not required
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,618
Office Version
  1. 2007
Platform
  1. Windows
Put this code in sheet event:

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, Range("B:AF")) Is Nothing Then
    If Target.Row < 2 Then Exit Sub
    UserForm1.Show
    Cancel = True
  End If
End Sub

SHEET EVENT
Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up.

__________________________________________________________________________
Create an userform like this:

1578515503398.png


__________________________________________________________________________
Put this code in userform

VBA Code:
Private Sub CommandButton1_Click()
  Call FillCell("Yellow", "L")
End Sub
Private Sub CommandButton2_Click()
  Call FillCell("Blue", "P")
End Sub
Private Sub CommandButton3_Click()
  Call FillCell("Pink", "S")
End Sub
Private Sub CommandButton4_Click()
  Call FillCell("Red", "X")
End Sub
Private Sub CommandButton5_Click()
  Call FillCell("Green", "V")
End Sub

Sub FillCell(sColor As String, sLetter As String)
  Dim vColor
  Select Case sColor
    Case "Yellow": vColor = vbYellow
    Case "Blue": vColor = vbBlue
    Case "Pink": vColor = 13408767
    Case "Red": vColor = vbRed
    Case "Green": vColor = vbGreen
  End Select
  ActiveCell.Interior.Color = vColor
  ActiveCell.Value = sLetter
End Sub
 

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
23,951

ADVERTISEMENT

Can I suggest an alternate user interface. Eliminate the userform and double click on the cell to scroll through the options.
Double click once, Yellow L
Double click again, Blue P
etc until Double click again blank white.

VBA Code:
With Target
    If .Value = "L" Then
        .Interior.Color = vbBlue
        .Value = "P"
    ElseIf .Value = "P" Then
        .Interior.Color = vbPink
        .Value = "S"
    ElseIf .Value = "S" Then
        .Interior.Color = vbRed
        .Value = "X"
    ElseIf .Value = "X"
        .Interior.Color = vbGreen
        .Value = "V"
    Else
        .Interior.Color = vbYellow
       .Value = "L"
    End If
End With
(yeah, theres' no vbpink )
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

variation on @mikerickson suggestion
place code in sheet module
double-click in cell triggers change
VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim a As Integer, x, y
    Cancel = True
    x = Array("", "L", "P", "S", "X", "V", "")                'empty string is deliberately repeated
    y = Array(34, 35, 36, 38, 40, 0)
    For a = 0 To UBound(x)
        If Target.Value = x(a) Then
            Target.Value = x(a + 1)
            Target.Interior.ColorIndex = y(a)
            Exit For
        End If
    Next a
End Sub

The ColorIndex numbers can be found here Color Palette and the 56 Excel ColorIndex Colors
(the above were selected at random)
 

harveya915

Board Regular
Joined
Sep 4, 2015
Messages
101
Your previous threads show that you have some experience with VBA, what exactly do you need help with?
I don't know VBA at all. Never studied it or had any training on it. However, I try to search for my answers as much as I can. I save all codes that have been provided to me and extract bits and pieces from each to try and solve first what I need. Just by observing I have come to know what some things mean and what they do, but in actuality I really don't know. It really helps when people explain the lines of code using an apostrophe and the text is in green (as you can see in the above post by Yongle).
 

Eric W

MrExcel MVP
Joined
Aug 18, 2015
Messages
10,744
At the risk of muddying the waters even more, let me suggest another option. We can add some options to the right-click Context Menu. So when you right click on the cell, the context menu comes up, then you select the option you want and you're done. No user form necessary, and you don't need to double click 4 times to get to the option you want. If you want to try that, open the VBA editor (Alt-F11). Double click on the ThisWorkbook module on the left, and paste this code:

VBA Code:
' Add the formatting macros to the right click menu
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim i As Long, MacroText As Variant
    
' This is the list of descriptions that will show up in the context menu
    MacroText = Array("Later", "Previous", "Sooner", "Extract all", "Validate Code", "Clear cell")
    
' So that we don't keep adding duplicate options, remove the old options
' This also removes the options for cells not in the specific range
    On Error Resume Next
    For Each x In MacroText
        Application.CommandBars("Cell").Controls(x).Delete
    Next x
    
' This restricts the new options to a particular sheet and column.  You can put whatever range you want.
    If ActiveSheet.Name <> "Sheet1" Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
    
' If we are in the right range, add the options to the right-click menu
    For i = 0 To UBound(MacroText)
        With Application.CommandBars("Cell").Controls.Add(Temporary:=True)
           .Caption = MacroText(i)
           .Style = msoButtonCaption
           .OnAction = "'Change_Cell " & i & "'"
        End With
    Next i
    
End Sub
' Before exiting the workbook, make sure we remove the options
Private Sub Workbook_Deactivate()
Dim x As Variant, MacroText As Variant

    MacroText = Array("Later", "Previous", "Sooner", "Extract all", "Validate Code", "Clear cell")
    
    On Error Resume Next
    For Each x In MacroText
        Application.CommandBars("Cell").Controls(x).Delete
    Next x

End Sub

Notice the 2 lines in the middle that restrict the options to a particular sheet and column. You should change that to the specific location in your workbook.

Now insert a standard module (Alt-IM), and paste this code:

VBA Code:
Public Function Change_Cell(x)
    clr = Array(vbYellow, vbBlue, RGB(255, 150, 200), vbRed, vbGreen, xlNone)
    Vlu = Array("L", "P", "S", "X", "V", "")
    ActiveCell.Interior.Color = clr(x)
    ActiveCell = Vlu(x)
End Function

That should do it. Go back to your worksheet and try it out. Let me know if you have any questions.
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,127,100
Messages
5,622,724
Members
415,923
Latest member
Kam80

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
Top