excelvbadrop-down-menuexcel-2013checkmark

VBA Excel 2013 Column Range with Drop Down List to Create VBA Code to Select All & Deselect All Check Marks

I'm newer to vba and need assistance. Currently, I have a drop-down list in a specific column (E1:E519) where staff can choose a check mark or leave it blank. However, if someone has 400 people or so to check boxes for, this can be annoying. So this prompted me to create a command button on the side using vba to select and deselect all in that specific column range.

How do I create a vba code that only allows checks to fill in the blanks in a selected range in cells that have a drop down list option (there is only 1 option in the drop down list, which is a check mark). The drop down list must remain for users who prefer to check each box individually and not use a command button. Column E either gets a check or is left blank. It'd be much easier if it recognized that if column B has data, then a check mark should be added to column E in the same row. If there is a code for that I would sure appreciate all the help I can get. The exact check mark I use is Arial Unicode MS font with a subset Dingbat character code 2713.

Can someone please help me and show me how to do it properly? I would also appreciate a bit of an explanation so that I can understand the code language and further learn. Thank you!

Current Code I'm Using (shows "?" instead of a check that is located in cell E14 (row 14, column 5) which is a check mark):

Private Sub CommandButton1_Click()

Dim c As Range
Dim check As Long

check = 0 'Define 0 for crossmark or 1 for checkmark

For Each c In Range("E17:E519") 'Define your range which should look value not equal to 1, then loop through that range.
If c <> 1 Then 'check if value in range is not equal to 1
With c 'Define what you want to do with variable c
    If check = 1 Then 'If check = 1, then
        .Font.Name = "Arial Unicode MS" 'Apply font "Arial Unicode MS"
        .Font.Size = 12 'Font size
        .FormulaR1C1 = "ü" 'special character for checkmark
    ElseIf check = 0 Then 'If cehck = 1, then
        .Font.Name = "Arial Unicode MS" 'Apply font "Arial Unicode MS"
        .Font.Size = 12 'Font size
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .FormulaR1C1 = "?"
End If
End With
End If
Next c
End Sub

Next code

Sub change_cells_ref2()
        Dim ws As Worksheet
        Dim c As Range
        Dim c_row_number As Long
        Dim rangeinput As Variant

    Set ws = Worksheets("NFLES ILT Form") 'Define the worksheet the code should be applied to
Application.ScreenUpdating = False 'Turn off screen update, makes the calculations more smooth and faster.

Set rangeinput = Range("E17:E519") 'Set Range where you want to check if the variable c is empty. If you have headers, set "B2:B519"

For Each c In rangeinput 'This line defines your range where you are looking for "", then loop through that range.
c_row_number = c.Row 'Gives us the current row number for the loop variable c which we are looping.
    If c <> "" Then 'Checks if the value in variable c is empty
        ws.Cells(14, "E").Copy 'Copy from cell(14,5) where cells(row number, column number). This will copy row 14, column 5, which is cell E14
        ws.Cells(c_row_number, "E").PasteSpecial xlPasteAll 'Paste into current row in loop and column 5 (column E)
    End If 'End the if statement where we check which value variable c has.
Next c 'Go to next c in the range

Application.CutCopyMode = False 'Cancel any copy selection
Application.ScreenUpdating = True 'Turn off screen update

End Sub
Solution

  • The tricky part here is what kind of character you have used for crossmark/ticker. So I list two approaches, which the first one I have used earlier.
    As I want it to be standardized in both macro and dropdown list I choose a character set in the cells B1 and B2 as dummy variables.

    B1 = checkmarks (✓) = 1 and B2 = crossmarks (✗) = 0. The great benefit is that I can use the same characters in my drop down-list (see picture) and the VBA code. Notice that both my cells, B1 and B2 has drop-down lists. When my code copy these cells, the drop-down list will follow to the new cells.

    enter image description here

    When I run the code I first need to choose 1 or 0. What you choose depends if the code will copy checkmarks (which is value 1) or crossmarks (value 0).

    enter image description here

    Next window is where you define your range. You can either write it like: E20:E50 or you can select it by selecting with your mouse.

    enter image description here

    Then the code processes and the result will be changed cells:

    enter image description here

    VBA Code:

    Sub change_cells_ref()
Dim c As Range
Dim check_or_cross As Variant
Dim c_row_number As Long
Dim rangeinput As Variant

check_or_cross = Application.InputBox("Enter ""1"" for checkmark or ""0"" for crossmark") 'Input box for checkmarks (enter: 1) or crossmarks (enter: 0)
On Error Resume Next 'If error occurs, this is not a good way to mask errors... but if you press cancel in the inputbox when you are setting a range, VBA automatically throws an error: 13 before we can catch it, so we mask any errors that can occurs.
Set rangeinput = Application.InputBox(prompt:="Select range or Enter range, i.e. E17:E150", Type:=8) ' Input box for Range, Type:=8 tells us that the value has to be in range format. You could either select or write range.

For Each c In rangeinput 'Range("E17:E150") - remove "rangeinput" to have a static range. This line defines your range where you are look for "zxyx", then loop through that range.
    c_row_number = c.Row 'Gives us the current row for the loop variable c which we are looping.
        If c <> "zxyz" Then 'Checks if the value is combination that is very unlikely to occur. It will overwrite all those values that are not "zxyz".
        'If you replace the above code line with [If c = "" Then] the code would only overwrite cells that has not checkmark or crossmark...i,e only empty cells, could be good if you have some workers who answered, and some that hasn't. And only want to fill in those who didn't answer quickly.
            With c 'Define what you want to do with the variable c
                If check_or_cross = 1 Then 'If the user wrote 1, then copy checkmarks
                    .Font.Name = "Times New Roman" 'Set font that you want to use, remember all fonts doesn't support special characters/crossmark/checkmarks
                    .Font.Size = 12 'Set the Font size
                    Cells(1, 2).Copy 'Copy from cell(1,2) where cells(row number, column number). This will copy row 1, column 2, which is cell B1
                    Cells(c_row_number, 5).PasteSpecial xlPasteAll 'Paste into current row in loop and column 5 (column E)
                ElseIf check_or_cross = 0 Then 'If the user wrote 0, then copy crossmarks
                    .Font.Name = "Times New Roman" 'Set font that you want to use, remember all fonts doesn't support special characters/crossmark/checkmarks
                    .Font.Size = 12 'Set the Font size
                    Cells(2, 2).Copy 'Copy from cell(2,2) where cells(row number, column number). This will copy row 2, column 2, which is cell B2
                    Cells(c_row_number, 5).PasteSpecial xlPasteAll 'Paste into current row in loop and column 5 (column E)
                End If 'End the if statement (if check_or_cross is 1 or 0)
            End With 'Close the With c part
        End If 'End the if statement where we check which value c has.
Next c 'Go to next c in the range
On Error GoTo 0
End Sub

    If you always want a static range and skip the input box for the range part, you could remove these 3 lines: 

    On Error Resume Next
Set rangeinput = Application.InputBox(prompt:="Select range or Enter range, i.e. E17:E150", Type:=8) 
'...code....
On Error GoTo 0

    And then replace this part For Each c In rangeinput -> For Each c In Range("E17:E517") - where E17:E517 is your range that you want to change the check/crossmarks

    Alternative approach:

    This code uses the font size "Wingding".

    The disadvantage here is that you are not able to use this style in a "good" way in drop-down list. You will have values "ü" = ✓ and for û = ✗. That means in the drop-down list you will have u's, but in macro it will show correct values when the result is presented.

    Advantage is that you don't need any dummy cells, as code will not copy any cells. It writes the values directly from the code. If you have case where you only want to use macro and no drop-down list, this could be a perfect approach.

    enter image description here

    Sub change_cells()
Dim c As Range
Dim check As Long

check = 0 'Define 0 for crossmark or 1 for checkmark

For Each c In Range("E17:E150") 'Define your range which should look value not equal to 1, then loop through that range.
    If c <> 1 Then 'check if value in range is not equal to 1
    With c 'Define what you want to do with variable c
        If check = 1 Then 'If cehck = 1, then
            .Font.Name = "Wingdings" 'Apply font "Wingdings"
            .Font.Size = 12 'Font size
            .FormulaR1C1 = "ü" 'special character for checkmark
        ElseIf check = 0 Then 'If cehck = 1, then
            .Font.Name = "Wingdings" 'Apply font "Wingdings"
            .Font.Size = 12 'Font size
            .FormulaR1C1 = " û " 'special character for crossmark
        End If
    End With
End If
Next c
End Sub

    Another light approach is shown in the result below:

    enter image description here

    The code will look if the cell in column B is not empty. If cell is not empty (formulas that returns: "" are treated as empty) it will copy the value from dummy cell A1 and paste in the column E in the same row.

    Notice to setup a dummy cell with data-validation and the checkmark ✓. The reason is that the character 2713 is a special character and in VBA it would have result in "?" character. Therefore we copy it in the excel environment where it can be treated correctly including the drop-down list

    Variables to in the code set:

    VBA Code:

    Sub change_cells_ref2()
Dim ws As Worksheet
Dim c As Range
Dim c_row_number As Long
Dim rangeinput As Variant

Set ws = Worksheets("Sheet1") 'Define the worksheet the code should be applied to
Application.ScreenUpdating = False 'Turn off screen update, makes the calculations more smooth and faster.

Set rangeinput = Range("B1:B519") 'Set Range where you want to check if the variable c is empty. If you have headers, set "B2:B519"

For Each c In rangeinput 'This line defines your range where you are looking for "", then loop through that range.
    c_row_number = c.Row 'Gives us the current row number for the loop variable c which we are looping.
        If c <> "" Then 'Checks if the value in variable c is empty
            ws.Cells(1, "A").Copy 'Copy from cell(1,1) where cells(row number, column number). This will copy row 1, column 1, which is cell A1
            ws.Cells(c_row_number, "E").PasteSpecial xlPasteAll 'Paste into current row in loop and column 5 (column E)
        End If 'End the if statement where we check which value variable c has.
Next c 'Go to next c in the range

Application.CutCopyMode = False 'Cancel any copy selection
Application.ScreenUpdating = True 'Turn off screen update

End Sub