none
Creating, naming etc a large amount of check boxes. RRS feed

  • Question

  • Hi all!

    I'm getting some problems with checkboxes.

    First, i have 132 checkboxes.

    I need to create more 3 rows of that, so, ill get 132*4 = 528 checkboxes.

    My problems is:

    How to create that amout of boxes via vba;

    How to auto name each row of checkboxes e.g. "gegov_5 to gegov_136"(yeah, is 132, but i need to name it starting in 5 ).

    How to put the same text (e.g. "GEGOV") in each row.

    So, basicaly, i need a code to create 132 checkboxes, name it automaticaly, and give it a text. So, i made it 2 more times to others rows.

    Ok, now, the other problem. 

    I already created the first row, 132 checkboxes, named it, and put the text.

    But, when i run the macro, to check if each checkbox is selected  to put a value of one cell to other , it takes a while (like 15-20 secs).

    It makes me think... With 528 checkboxes, it ill take too long to run this macro?

    This is the code:

    Sub troca()
    
    Dim i As Integer
    
        For i = 5 To 136
    
    '--------------------------------------------------------------
    'PARA GEGOV
            If Plan1.CheckBoxes("gegov_" & i).Value = 1 Then
                Plan2.Cells(i, 3).Value = Plan1.Cells(i, 3)
                Plan2.Cells(i, 4).Value = Plan1.Cells(i, 4)
            Else
                Plan2.Cells(i, 3).Value = 0
                Plan2.Cells(i, 4).Value = 0
            End If
            
    '-------------------------------------------------------------
    'PARA GEFIC <<<< HERE ILL BE THE NEXT ROW
    '        If Plan1.CheckBoxes("gefic_" & i).Value = 1 Then
    '            Plan3.Cells(i, 3).Value = Plan1.Cells(i, 3)
    '            Plan3.Cells(i, 4).Value = Plan1.Cells(i, 4)
    '        Else
    '            Plan3.Cells(i, 3).Value = 0
    '            Plan3.Cells(i, 4).Value = 0
    '        End If
    '
    Next i
    
    End Sub
    

    Explaining: I need to check if a cell belongs to "GEGOV" and/or "GEFIC" and/or "ETC"(each cell ill have 4 checkboxes)... to affect another sheet.

    If anyone can help me with my idea, or have a better idea ill be great! Thank you all!

    Wednesday, September 17, 2014 5:52 PM

Answers

  • Forget Troca - do it all in the same event code - just replace all the "?" with the correct column number or letters: The filled in values are for column E (5) - need to replace the ?s for F, G, and H.

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Dim i As Long
        
        If Target.Cells.Count > 1 Then Exit Sub
        If Intersect(Target, Range("E5:H136")) Is Nothing Then Exit Sub
        
        i = Target.Row
        
        Application.EnableEvents = False
        
        If Target.Value = "" Then
            Target.Value = "X"
            If Target.Column = 5 Then
                Plan2.Cells(i, 3).Value = Plan1.Cells(i, 3)
                Plan2.Cells(i, 4).Value = Plan1.Cells(i, 4)
            End If
            If Target.Column = 6 Then
                Plan?.Cells(i, "?").Value = Plan1.Cells(i, "?")
                Plan?.Cells(i, "?").Value = Plan1.Cells(i, "?")
            End If
            If Target.Column = 7 Then
                Plan?.Cells(i, "?").Value = Plan1.Cells(i, "?")
                Plan?.Cells(i, "?").Value = Plan1.Cells(i, "?")
            End If
            If Target.Column = 8 Then
                Plan?.Cells(i, "?").Value = Plan1.Cells(i, "?")
                Plan?.Cells(i, "?").Value = Plan1.Cells(i, "?")
            End If
        Else
            Target.Value = ""
            If Target.Column = 5 Then
                Plan2.Cells(i, 3).Value = 0
                Plan2.Cells(i, 4).Value = ""
            End If
            If Target.Column = 6 Then
                Plan?.Cells(i, "?").Value = 0
                Plan?.Cells(i, "?").Value = ""
            End If
            If Target.Column = 7 Then
                Plan?.Cells(i, "?").Value = 0
                Plan?.Cells(i, "?").Value = ""
            End If
            If Target.Column = 8 Then
                Plan?.Cells(i, "?").Value = 0
                Plan?.Cells(i, "?").Value = ""
            End If
        End If
        
        Application.EnableEvents = True

    End Sub

    • Marked as answer by BSBAwq Thursday, September 18, 2014 3:33 PM
    Thursday, September 18, 2014 3:10 PM

All replies

  • Simple solution:  Don't.... use..... checkboxes. You can create a grid of cells that act like checkboxes, or radio buttons, or listboxes using event code that will be much faster and easier to maintain. Or you can use formulas that link the cells instead of using .Value assignments.  So, describe in words what you want, and the event code should be fairly straightforward.
    Wednesday, September 17, 2014 6:19 PM
  • Ok!

    I need something like this:

    in line 5 i have 

    [A5]Human Resources

    [B5]Year

    [C5]Status 

    [D5]Description  

    [E5]<<manager>>

    So, in manager(cell E5), ill be 4 possible types and i need to check if that cell belongs to 1, 2, 3, 4 or all types.

    If i mark some type, that line ill be copied in another sheet. And can be marked one or more types.

    I just need the code that check E5, thanks for help!


    • Edited by BSBAwq Thursday, September 18, 2014 12:58 PM
    Thursday, September 18, 2014 12:55 PM
  • Here's one way:

    In E4:H4, enter the 4 different options as headers, which match sheet names. Then use code like this to enter checks in cells E5:H5, and copy the values in A5:D5 to the indicated sheets: copy the code, right-click the sheet tab, and select "View Code" then paste the code into the window that appears.

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Dim r As Range
        If Target.Cells.Count > 1 Then Exit Sub
        
        Application.EnableEvents = False
        
        If Not Intersect(Target, Range("E5:H5")) Is Nothing Then
            With Target
                .Font.Name = "WingDings"
                If .Value = Chr(252) Then
                    .Clear
                    boolChange = False
                Else
                    .Value = Chr(252)
                    boolChange = True
                End If
            End With
        Else
            If boolChange Then
                boolChange = False
                For Each r In Range("E5:H5")
                    If r.Value = Chr(252) Then
                        Range("A5:D5").Copy Worksheets(Cells(4, r.Column).Value).Cells(Rows.Count, "A").End(xlUp)(2)
                    End If
                Next r
            End If
        End If
        
        Application.EnableEvents = True

    End Sub

    This code can be extended to other rows very easily.
    Thursday, September 18, 2014 2:16 PM
  • Man, its exactly what i want!

    But, got some issues;

    When i click, ok, its mark.

    When i click again, if i want to unmark, i lost formatting(bordes, etc);

    So, i thought in this:

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i As Integer
    
        For i = 5 To 136
            If Target.Address = Range("E" & i).Address Then 'here E cell can be changed for F, G and H, as a need;
            Range("E" & i).Value = "x" 'or that mark that you did
            End If
        Next i
    
    End Sub

    So, the problems with my code:

    It wont unmark in second click;

    if i call the sub "troca"

    its still takes too long to run;

    Sub troca()
    
    Dim i As Integer
    
        For i = 5 To 136
    
    '--------------------------------------------------------------
    'PARA GEGOV
            If Plan1.Cells(i, 5).Value = "X" Then
                Plan2.Cells(i, 3).Value = Plan1.Cells(i, 3)
                Plan2.Cells(i, 4).Value = Plan1.Cells(i, 4)
            Else
                Plan2.Cells(i, 3).Value = 0
                Plan2.Cells(i, 4).Value = ""
            End If
    
    Next i
    
    End Sub
    

    Just this steps to finish my problem, 

    Again man, really thanks for support!

    Thursday, September 18, 2014 2:50 PM
  • Forget Troca - do it all in the same event code - just replace all the "?" with the correct column number or letters: The filled in values are for column E (5) - need to replace the ?s for F, G, and H.

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Dim i As Long
        
        If Target.Cells.Count > 1 Then Exit Sub
        If Intersect(Target, Range("E5:H136")) Is Nothing Then Exit Sub
        
        i = Target.Row
        
        Application.EnableEvents = False
        
        If Target.Value = "" Then
            Target.Value = "X"
            If Target.Column = 5 Then
                Plan2.Cells(i, 3).Value = Plan1.Cells(i, 3)
                Plan2.Cells(i, 4).Value = Plan1.Cells(i, 4)
            End If
            If Target.Column = 6 Then
                Plan?.Cells(i, "?").Value = Plan1.Cells(i, "?")
                Plan?.Cells(i, "?").Value = Plan1.Cells(i, "?")
            End If
            If Target.Column = 7 Then
                Plan?.Cells(i, "?").Value = Plan1.Cells(i, "?")
                Plan?.Cells(i, "?").Value = Plan1.Cells(i, "?")
            End If
            If Target.Column = 8 Then
                Plan?.Cells(i, "?").Value = Plan1.Cells(i, "?")
                Plan?.Cells(i, "?").Value = Plan1.Cells(i, "?")
            End If
        Else
            Target.Value = ""
            If Target.Column = 5 Then
                Plan2.Cells(i, 3).Value = 0
                Plan2.Cells(i, 4).Value = ""
            End If
            If Target.Column = 6 Then
                Plan?.Cells(i, "?").Value = 0
                Plan?.Cells(i, "?").Value = ""
            End If
            If Target.Column = 7 Then
                Plan?.Cells(i, "?").Value = 0
                Plan?.Cells(i, "?").Value = ""
            End If
            If Target.Column = 8 Then
                Plan?.Cells(i, "?").Value = 0
                Plan?.Cells(i, "?").Value = ""
            End If
        End If
        
        Application.EnableEvents = True

    End Sub

    • Marked as answer by BSBAwq Thursday, September 18, 2014 3:33 PM
    Thursday, September 18, 2014 3:10 PM
  • Done, it works!

    Thanks man!

    Thursday, September 18, 2014 3:33 PM