Add codes for dynamically created Active x-check boxes using vba

sujin_sam · Jan 31, 2017

Code:

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: inherit;">[COLOR=#101094]Dim[/COLOR][COLOR=#303336] t [/COLOR][COLOR=#101094]As[/COLOR][COLOR=#101094]Long[/COLOR][COLOR=#303336]
[/COLOR][COLOR=#101094]Dim[/COLOR][COLOR=#303336] u [/COLOR][COLOR=#101094]As[/COLOR][COLOR=#101094]Long[/COLOR][COLOR=#303336]
[/COLOR][COLOR=#101094]Dim[/COLOR][COLOR=#303336] v [/COLOR][COLOR=#101094]As[/COLOR][COLOR=#101094]Long[/COLOR][COLOR=#303336]
[/COLOR][COLOR=#101094]Dim[/COLOR][COLOR=#303336] q [/COLOR][COLOR=#101094]As[/COLOR][COLOR=#101094]Long[/COLOR][COLOR=#303336]
[/COLOR][COLOR=#101094]Dim[/COLOR][COLOR=#303336] p [/COLOR][COLOR=#101094]As[/COLOR][COLOR=#101094]Long[/COLOR][COLOR=#303336]
t [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]1[/COLOR][COLOR=#303336]
u [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]1[/COLOR][COLOR=#303336]    
 [/COLOR][COLOR=#101094]Do[/COLOR][COLOR=#303336]
        [/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336] Sheet2[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Range[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"D"[/COLOR][COLOR=#303336]&[/COLOR][COLOR=#303336] t[/COLOR][COLOR=#303336]).[/COLOR][COLOR=#303336]Value [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]""[/COLOR][COLOR=#101094]Then[/COLOR][COLOR=#303336]
         [/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336] Sheet2[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Range[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"D"[/COLOR][COLOR=#303336]&[/COLOR][COLOR=#303336] t [/COLOR][COLOR=#303336]+[/COLOR][COLOR=#7D2727]1[/COLOR][COLOR=#303336]).[/COLOR][COLOR=#303336]Value [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]""[/COLOR][COLOR=#101094]Then[/COLOR][COLOR=#303336]
           [/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336] Sheet2[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Range[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"D"[/COLOR][COLOR=#303336]&[/COLOR][COLOR=#303336] t [/COLOR][COLOR=#303336]+[/COLOR][COLOR=#7D2727]2[/COLOR][COLOR=#303336]).[/COLOR][COLOR=#303336]Value [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]""[/COLOR][COLOR=#101094]Then[/COLOR][COLOR=#303336]
             [/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336] Sheet2[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Range[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"D"[/COLOR][COLOR=#303336]&[/COLOR][COLOR=#303336] t [/COLOR][COLOR=#303336]+[/COLOR][COLOR=#7D2727]3[/COLOR][COLOR=#303336]).[/COLOR][COLOR=#303336]Value [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]""[/COLOR][COLOR=#101094]Then[/COLOR][COLOR=#303336]
              [/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336] Sheet2[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Range[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"D"[/COLOR][COLOR=#303336]&[/COLOR][COLOR=#303336] t [/COLOR][COLOR=#303336]+[/COLOR][COLOR=#7D2727]4[/COLOR][COLOR=#303336]).[/COLOR][COLOR=#303336]Value [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]""[/COLOR][COLOR=#101094]Then[/COLOR][COLOR=#303336]
               [/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336] Sheet2[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Range[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"C"[/COLOR][COLOR=#303336]&[/COLOR][COLOR=#303336] t[/COLOR][COLOR=#303336]).[/COLOR][COLOR=#303336]Value [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]""[/COLOR][COLOR=#101094]Then[/COLOR][COLOR=#303336]
                [/COLOR][COLOR=#101094]Exit[/COLOR][COLOR=#101094]Do[/COLOR][COLOR=#303336]
               [/COLOR][COLOR=#101094]End[/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336]
              [/COLOR][COLOR=#101094]End[/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336]
             [/COLOR][COLOR=#101094]End[/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336]
           [/COLOR][COLOR=#101094]End[/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336]
         [/COLOR][COLOR=#101094]End[/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336]
      [/COLOR][COLOR=#101094]End[/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336]
      [/COLOR][COLOR=#101094]If[/COLOR][COLOR=#101094]Not[/COLOR][COLOR=#303336] Sheet2[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Range[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"D"[/COLOR][COLOR=#303336]&[/COLOR][COLOR=#303336] t[/COLOR][COLOR=#303336]).[/COLOR][COLOR=#303336]Value [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]""[/COLOR][COLOR=#101094]Then[/COLOR][COLOR=#303336]
        [/COLOR][COLOR=#101094]If[/COLOR][COLOR=#101094]Not[/COLOR][COLOR=#303336] Sheet2[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Range[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"D"[/COLOR][COLOR=#303336]&[/COLOR][COLOR=#303336] t[/COLOR][COLOR=#303336]).[/COLOR][COLOR=#303336]Value [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]"Description"[/COLOR][COLOR=#101094]Then[/COLOR][COLOR=#303336]
          v [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#303336] Sheet2[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Range[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"A"[/COLOR][COLOR=#303336]&[/COLOR][COLOR=#7D2727]1[/COLOR][COLOR=#303336]&[/COLOR][COLOR=#7D2727]":"[/COLOR][COLOR=#303336]&[/COLOR][COLOR=#7D2727]"A"[/COLOR][COLOR=#303336]&[/COLOR][COLOR=#303336] t [/COLOR][COLOR=#303336]-[/COLOR][COLOR=#7D2727]1[/COLOR][COLOR=#303336]).[/COLOR][COLOR=#303336]Height
          q [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#303336] Sheet2[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Range[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"A"[/COLOR][COLOR=#303336]&[/COLOR][COLOR=#303336] t[/COLOR][COLOR=#303336]).[/COLOR][COLOR=#303336]Height
          p [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#303336] v [/COLOR][COLOR=#303336]+[/COLOR][COLOR=#303336]([/COLOR][COLOR=#303336]q [/COLOR][COLOR=#303336]/[/COLOR][COLOR=#7D2727]2[/COLOR][COLOR=#303336])[/COLOR][COLOR=#303336]-[/COLOR][COLOR=#7D2727]5[/COLOR][COLOR=#303336]
          [/COLOR][COLOR=#101094]Set[/COLOR][COLOR=#303336] obj [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#303336] Sheet2[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]OLEObjects[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Add[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"Forms.checkbox.1"[/COLOR][COLOR=#303336])[/COLOR][COLOR=#303336]
          [/COLOR][COLOR=#101094]With[/COLOR][COLOR=#303336] obj
           [/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Width [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]10[/COLOR][COLOR=#303336]
           [/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Top [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#303336] p
           [/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Left [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]875[/COLOR][COLOR=#303336]
           [/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Height [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]10[/COLOR][COLOR=#303336]
          [/COLOR][COLOR=#101094]End[/COLOR][COLOR=#101094]With[/COLOR][COLOR=#303336]
          u [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#303336] u [/COLOR][COLOR=#303336]+[/COLOR][COLOR=#7D2727]1[/COLOR][COLOR=#303336]
        [/COLOR][COLOR=#101094]End[/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336]
      [/COLOR][COLOR=#101094]End[/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336]
      t [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#303336] t [/COLOR][COLOR=#303336]+[/COLOR][COLOR=#7D2727]1[/COLOR][COLOR=#303336]
     [/COLOR][COLOR=#101094]Loop[/COLOR]</code>

This Code will help me to create many active-x check boxes as per my requirement, I need to know how to add codes to these check boxes.every check boxes will have similar codes.
for example, a row will be mapped to these check boxes respectively. these check boxes will be checked and a command button will be clicked, which will copy the rows of selected check boxes to another sheet.
if possible i can create separate names for each check box while creating it nd add codes accordingly.
Is there any way?

sujin_sam · Feb 1, 2017

https://i.stack.imgur.com/YF2U2.png

In this image the checkboxes are created dynamically, my requirement is if i click a checkbox that particular row should be copied to another sheet, is there any way?

sujin_sam · Feb 1, 2017

sujin_sam said:
https://i.stack.imgur.com/YF2U2.png

In this image the checkboxes are created dynamically, my requirement is if i click a checkbox that particular row should be copied to another sheet, is there any way?

if i click the necessary check box,and the command button "export the nfr", the row corresponding to the selected check box should be copied to another sheet, is there any way to add codes for that manipulation

GTO · Feb 1, 2017

Greetings,

I see the Exit Do, but a Do...Loop without a While|Until just seems scary for some reason. It's not really, but here's another version.

In a Standard Module:

Rich (BB code):

Option Explicit
  
Sub exampleCreateCheckboxes()
Dim t As Long
Dim u As Long
Dim v As Long
Dim q As Long
Dim p As Long
Dim obj As OLEObject


  t = 2 ' 1 <--- would foul first time thru the loop
  u = 1
    
  With Sheet2
    Do While Not (.Cells(t, "D").Value = vbNullString _
                  And .Cells(t + 1, "D").Value = vbNullString _
                  And .Cells(t + 2, "D").Value = vbNullString _
                  And .Cells(t + 3, "D").Value = vbNullString _
                  And .Cells(t + 4, "D").Value = vbNullString _
                  And .Cells(t, "C").Value = vbNullString _
                  )
                  
      'If Not Sheet2.Range("D" & t).Value = "" Then '<--I think we already tested this
        If Not .Range("D" & t).Value = "Description" Then
          v = .Range("A" & 1 & ":" & "A" & t - 1).Height
          q = .Range("A" & t).Height
          p = v + (q / 2) - 5
          Set obj = Sheet2.OLEObjects.Add("Forms.Checkbox.1")
          With obj
            .Width = 10
            .Top = p
            .Left = 875
            .Height = 10
          End With
          u = u + 1
        End If
      'End If
      t = t + 1
    Loop
  End With
  
End Sub

As to the button's code, if you are just copying the rows that the ticked check boxes are in, you really don't need 'code-writing code' or their names. Presuming that the commandbutton is on Sheet2 and it is an ActiveX button...

In Sheet2's Module:

Rich (BB code):

Option Explicit
  
Private Sub CommandButton1_Click()
Dim objOleObject      As OLEObject
Dim WKS               As Worksheet
Dim lRow              As Long
Dim bolCheckboxExists As Boolean
  
  For Each objOleObject In Me.OLEObjects
    ' Confirm we are looking at least one ActiveX Checkbox
    If objOleObject.progID = "Forms.CheckBox.1" Then
      bolCheckboxExists = True
      Exit For
    End If
  Next
  
  If bolCheckboxExists Then
    lRow = 1
    ' You mentioned copying to another sheet; I just created a new one-sheet workbook
    ' for ease of demo.
    Set WKS = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    For Each objOleObject In Me.OLEObjects
      ' confirm we are looking at a check box before...
      If objOleObject.progID = "Forms.CheckBox.1" Then
        ' checking for the .Value property.
        If objOleObject.Object.Value = True Then
          lRow = lRow + 1
          objOleObject.TopLeftCell.EntireRow.Copy WKS.Rows(lRow)
        End If
      End If
    Next
  End If
  
End Sub

Hope that helps,

Mark

sujin_sam · Feb 1, 2017

It helps, Thank you soooo much Mark(GTO) .....

GTO · Feb 1, 2017

You are most welcome

sujin_sam · Feb 1, 2017

GTO said:

Greetings,

I see the Exit Do, but a Do...Loop without a While|Until just seems scary for some reason. It's not really, but here's another version.

In a Standard Module:

Rich (BB code):

Option Explicit
  
Sub exampleCreateCheckboxes()
Dim t As Long
Dim u As Long
Dim v As Long
Dim q As Long
Dim p As Long
Dim obj As OLEObject


  t = 2 ' 1 <--- would foul first time thru the loop
  u = 1
    
  With Sheet2
    Do While Not (.Cells(t, "D").Value = vbNullString _
                  And .Cells(t + 1, "D").Value = vbNullString _
                  And .Cells(t + 2, "D").Value = vbNullString _
                  And .Cells(t + 3, "D").Value = vbNullString _
                  And .Cells(t + 4, "D").Value = vbNullString _
                  And .Cells(t, "C").Value = vbNullString _
                  )
                  
      'If Not Sheet2.Range("D" & t).Value = "" Then '<--I think we already tested this
        If Not .Range("D" & t).Value = "Description" Then
          v = .Range("A" & 1 & ":" & "A" & t - 1).Height
          q = .Range("A" & t).Height
          p = v + (q / 2) - 5
          Set obj = Sheet2.OLEObjects.Add("Forms.Checkbox.1")
          With obj
            .Width = 10
            .Top = p
            .Left = 875
            .Height = 10
          End With
          u = u + 1
        End If
      'End If
      t = t + 1
    Loop
  End With
  
End Sub

As to the button's code, if you are just copying the rows that the ticked check boxes are in, you really don't need 'code-writing code' or their names. Presuming that the commandbutton is on Sheet2 and it is an ActiveX button...

In Sheet2's Module:

Rich (BB code):

Option Explicit
  
Private Sub CommandButton1_Click()
Dim objOleObject      As OLEObject
Dim WKS               As Worksheet
Dim lRow              As Long
Dim bolCheckboxExists As Boolean
  
  For Each objOleObject In Me.OLEObjects
    ' Confirm we are looking at least one ActiveX Checkbox
    If objOleObject.progID = "Forms.CheckBox.1" Then
      bolCheckboxExists = True
      Exit For
    End If
  Next
  
  If bolCheckboxExists Then
    lRow = 1
    ' You mentioned copying to another sheet; I just created a new one-sheet workbook
    ' for ease of demo.
    Set WKS = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    For Each objOleObject In Me.OLEObjects
      ' confirm we are looking at a check box before...
      If objOleObject.progID = "Forms.CheckBox.1" Then
        ' checking for the .Value property.
        If objOleObject.Object.Value = True Then
          lRow = lRow + 1
          objOleObject.TopLeftCell.EntireRow.Copy WKS.Rows(lRow)
        End If
      End If
    Next
  End If
  
End Sub

Hope that helps,

Mark

One more help, I want to copy the column from B:D of that selected checkbox row, instead of entire row, as u can see in the image and paste it to the active cell of new workbook sheet

Thanks in advance....

GTO · Feb 1, 2017

Change the .Copy line to something like:

**********'objOleObject.TopLeftCell.EntireRow.Copy WKS.Rows(lRow) **********Me.Range("B" & objOleObject.TopLeftCell.Row).Resize(, 3).Copy WKS.Rows(lRow) **********

sujin_sam · Feb 1, 2017

GTO said:
Change the .Copy line to something like:

**********'objOleObject.TopLeftCell.EntireRow.Copy WKS.Rows(lRow)
**********Me.Range("B" & objOleObject.TopLeftCell.Row).Resize(, 3).Copy WKS.Rows(lRow)
**********

ThankYou, In the line "WKS.Rows(lrow)" pastes the copied data, If we delete that we can paste to our requirements, Thanks once again Mark!!!!

Add codes for dynamically created Active x-check boxes using vba

sujin_sam

New Member

sujin_sam

New Member

sujin_sam

New Member

GTO

MrExcel MVP

sujin_sam

New Member

GTO

MrExcel MVP

sujin_sam

New Member

GTO

MrExcel MVP

sujin_sam

New Member

Similar threads

Share this page

Add codes for dynamically created Active x-check boxes using vba

New Member

New Member

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

Similar threads

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock