Select Rows on click of a CheckBox

[PritishS]

Dear Sir/Madam,

I'm having a Simple yet difficult problem which I can't figure out. I'm still a self learner of macro.

My doubt:

I have a Table where 5 column and many rows are there. All row of Col-A have a CheckBox (I added it from Developer Tab). Col-B, Col-C, Col-D and Col-E has value till many rows.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Col-A[/TD]
[TD]COL-B[/TD]
[TD]COL-C[/TD]
[TD]COL-D[/TD]
[TD]COL-E[/TD]
[/TR]
[TR]
[TD]Chkbox[/TD]
[TD]XYZ[/TD]
[TD]XSE[/TD]
[TD]ASD[/TD]
[TD]WER[/TD]
[/TR]
[TR]
[TD]Chkbox[/TD]
[TD]QWE[/TD]
[TD]QQW[/TD]
[TD]QQW[/TD]
[TD]WEE[/TD]
[/TR]
[TR]
[TD]Chkbox[/TD]
[TD]FGT[/TD]
[TD]RTY[/TD]
[TD]WQA[/TD]
[TD]LKK[/TD]
[/TR]
</tbody>[/TABLE]

Now If I click on Chkbox in Col A-1, then data of Col-B,C,D & E will be selected
I recorded a macro and assigned it to Chkbox in Col A-1

Sub Select_Data()
Range("B1:E1").Select
End Sub

But my requirement is, if I select checkbox in Col-A-2, then it should select Col-B2,C2,D2 & E2 and so on....

Problem 1:

Problem is I have many rows and I can not write that above code for each rows and assign it to particular checkbox.
Is there any possible way to do the above method with a single code which will be assigned to all checkbox?

Problem 2:

I want to select multiple checkbox and multiple row should be selected (as we manually select by pressing CTRL Key and Mouseover cells). Is it possible?

Please help me. I trying my best to find the solution but seems that's not enough.

Thanks & Regards,
PritishS

 

[ismii]

Using a form? If so, then just pop a checkbox on there and double click it. You should get a routine that will run if you change it. Then you can check if the value of it is True or False (checked or not checked) and select/deselect the certain rows.

 

[PritishS]

Hi ismii,

Thanks for your valuable time. Actually using a form is not a option as my users are not much familiar with using forms in excel. I want to keep it as simple as a non-technical user should be able to use it.
I found something similar in this website of Mr. OScar:
http://www.get-digital-help.com/2011/10/12/copy-selected-rows-checkboxes-22/

And I have modified this code as per my requirement.

Sub SelectRows()
Dim cell, LRow As Single
Dim chkbx As CheckBox


Application.ScreenUpdating = False
'LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row


For Each chkbx In ActiveSheet.CheckBoxes
    If chkbx.Value = 1 Then
        For r = 1 To Rows.Count
            If Cells(r, 1).Top = chkbx.Top Then
            ActiveSheet.Range("A" & r & ":D" & r).Select
                'With Worksheets("BOM")
                    'LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    '.Range("A" & LRow & ":D" & LRow) = _
                    'ActiveSheet.Range("A" & r & ":D" & r).Value
                'End With
                Exit For
            End If
        Next r
    End If
Next
End Sub

It solves my 1st problem. But not able to solve second problem.

Problem 2: I want to select multiple checkbox and multiple row should be selected (as we manually select by pressing CTRL Key and Mouseover cells). Is it possible?

Kindly help me.

Thanks & Regards,
PritishS

 

[ismii]

Option Explicit


Sub SelectRows()
    Dim cell As Range
    Dim LRow As Long
    Dim chkbx As CheckBox
    Dim rngSelect As Range
    Dim r As Long
    
    
    Application.ScreenUpdating = False
    LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    
    
    For Each chkbx In ActiveSheet.CheckBoxes
        If chkbx.Value = 1 Then
            For r = 1 To LRow
                If Cells(r, 1).Top = chkbx.Top Then
                    If rngSelect Is Nothing Then
                        Set rngSelect = ActiveSheet.Range("A" & r & ":D" & r)
                    Else
                        Set rngSelect = Union(ActiveSheet.Range("A" & r & ":D" & r), rngSelect)
                    End If
                    'With Worksheets("BOM")
                        'LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                        '.Range("A" & LRow & ":D" & LRow) = _
                        'ActiveSheet.Range("A" & r & ":D" & r).Value
                    'End With
                    Exit For
                End If
            Next r
        End If
    Next chkbx
    
    If Not rngSelect Is Nothing Then
        rngSelect.Select
    End If
    
End Sub

 

[ismii]

Make sure you don't use "Rows.Count" as something you're counting to, especially in an inner loop. For each checkbox you're going from 1 to >1 million rows. It's moving through every single row that Excel has rather than just the used range.

 

[PritishS]

Hi ismii,

Sorry for late reply!.. Due to festive season here I was in leave... Thanks for your valuable time & prompt support.
After joining to my work, I tried your code and modified it little bit. But unfortunately I have to drop this idea of using check box. Main problem is, my worksheets have approx 6000 to 10000 rows each. when i entered a checkbox and applied filter to filter desired data, all checkboxes messedup and overlapped. Also it slow down my excel file. Then I searched in google and found checkbox is not a good option to deal with large number of data.
Now I am trying to achieve the same with marlett checkbox method.

In this method by clicking on E col, data of A,B,C,D will move to another wroksheet named "BOM"
Code for Sheet Module:

Option Explicit 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


    If Target.Cells.Count > 1 Then Exit Sub
     
    If Not Intersect(Target, Range("E4:E200000")) Is Nothing Then
    
        Cancel = True 'Prevent going into Edit Mode
        
        Call Update_Quote
         
    End If
     
End Sub

Code for Standard Module:

Option Explicit 
Sub Update_Quote()
     
    Dim nextrow As Long, rngRow As Range, rfound As Range, sFind As String, Worksheet As Worksheet
     
    'nextrow = Worksheet("BOM").Cells(Rows.Count, "A").End(xlUp).Row + 1  'change "BOM" sheetname as required
     
    nextrow = Sheets("BOM").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Application.ScreenUpdating = False
     
    If Not Intersect(ActiveCell, Range("E4:E200000")) Is Nothing Then
         
        ActiveCell.Font.Name = "Marlett"
         
        Select Case ActiveCell.Value
        Case Is = vbNullString
            ActiveCell = "a"
            Set rngRow = Range("A" & ActiveCell.Row & ":D" & ActiveCell.Row)
            rngRow.Copy Sheets("BOM").Range("A" & nextrow)
             
        Case Is = "a"
            ActiveCell = vbNullString
             
            sFind = Range("A" & ActiveCell.Row).Value
             
            With Sheets("BOM")
                Set rfound = .Columns(1).Find(what:=sFind, after:=.Cells(1, 1))
                 
                'If Not rfound Is Nothing Then
                    'rfound.EntireRow.Delete
                'End If
            End With
        End Select
         
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        Set rngRow = Nothing
     
    End If
    
  
End Sub

Thanks & Regards,
PritishS