Search code examples
excelvbacheckboxuserform

add multiple workbooks using checkboxes


I have a userform with 2 checkboxes, when the user clicks on the send button it should copy the sheet 1 from currentWorkbook to a new workbook. If the user clicks in one of checkboxes (1 or 2) it works but if I clicks on the 2 checkboxes at the same time it doesn't work.

My goal is if the user clicks on the 2 checkboxes, it copies the sheet 1 from currentWorkbook to 2 new workbooks.

Any help is highly appreciated.

Private Sub CommandButton1_Click()

Dim theNewWorkbook As Workbook
Dim currentWorkbook As Workbook
Dim sFileSaveName As Variant
Dim industry As String
Dim dttoday As String

Set currentWorkbook = Workbooks("blabla" & ".xlsm")
Set theNewWorkbook = Workbooks.Add
currentWorkbook.Sheets("Sheet1").Activate

If one= True Then
currentWorkbook.Worksheets("Sheet1").Copy before:=theNewWorkbook.Sheets(1)
    With ActiveSheet
        .ListObjects(1).Name = "one"
    End With
ActiveSheet.ListObjects("one").Range.AutoFilter Field:=1, Criteria1:= _
        Array("bla", "ble", "bli", "blo"), _
        Operator:=xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.ShowAllData

'Save File

industry = "one "
dttoday = VBA.format(Now(), "ddmmyyyy")
saveLocation = "C:\blabla" & industry & dttoday & ".xlsx"
sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=saveLocation, fileFilter:="Excel Files (*.xlsx), *.xlsx")
If sFileSaveName <> "False" Then ActiveWorkbook.SaveAs sFileSaveName
theNewWorkbook.Close

End If

If two = True Then
currentWorkbook.Worksheets("Sheet1").Copy before:=theNewWorkbook.Sheets(1)
    With ActiveSheet
        .ListObjects(1).Name = "two"
    End With
ActiveSheet.ListObjects("two").Range.AutoFilter Field:=1, Criteria1:= _
        Array("bla", "ble", "bli"), _
        Operator:=xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.ShowAllData

'Save File

industry = "two "
dttoday = VBA.format(Now(), "ddmmyyyy")
saveLocation = "C:\blabla_" & industry & dttoday & ".xlsx"
sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=saveLocation, fileFilter:="Excel Files (*.xlsx), *.xlsx")
If sFileSaveName <> "False" Then ActiveWorkbook.SaveAs sFileSaveName
End If
Unload Me
End Sub

Solution

  • This code should do the following:

    • If checkbox one is checked create a new workbook with a copy of Sheet1 from the current workbook in it and name the table on the copied sheet 'one'.

    • If checkbox two is checked create a new workbook with a copy Sheet1 from the current workbook in it and name the table on the copied sheet 'two'.

    • Do both if both checkboxes are checked.

    Option Explicit
    
    Private Sub CommandButton1_Click()
    Dim theNewWorkbook As Workbook
    Dim currentWorkbook As Workbook
    Dim sFileSaveName As Variant
    Dim industry As String
    Dim dttoday As String
    
        Set currentWorkbook = Workbooks("blabla" & ".xlsm")
    
        If one = True Then
            currentWorkbook.Worksheets("Sheet1").Copy
            Set theNewWorkbook = ActiveWorkbook
            With theNewWorkbook
                With .ActiveSheet
                    .ListObjects(1).Name = "one"
                    .ListObjects("one").Range.AutoFilter Field:=1, Criteria1:= _
                                                         Array("bla", "ble", "bli"), _
                                                         Operator:=xlFilterValues
                    .Range(.Rows("2:2"), .Rows("2:2").End(xlDown)).Delete
                    .ShowAllData
                End With
    
    
                'Save File
    
                industry = "one "
                dttoday = Format(Now(), "ddmmyyyy")
                saveLocation = "C:\blabla" & industry & dttoday & ".xlsx"
                sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=saveLocation, fileFilter:="Excel Files (*.xlsx), *.xlsx")
                If sFileSaveName <> "False" Then
                    .SaveAs sFileSaveName
                End If
                .Close
            End With
        End If
    
        If two = True Then
            currentWorkbook.Worksheets("Sheet1").Copy
            Set theNewWorkbook = ActiveWorkbook
            With theNewWorkbook
                With .ActiveSheet
                    .ListObjects(1).Name = "two"
                    .ListObjects("two").Range.AutoFilter Field:=1, Criteria1:= _
                                                         Array("bla", "ble", "bli", "blo"), _
                                                         Operator:=xlFilterValues
                    .Range(.Rows("2:2"), .Rows("2:2").End(xlDown)).Delete
                    .ShowAllData
                End With
    
    
                'Save File
    
                industry = "two "
                dttoday = Format(Now(), "ddmmyyyy")
                saveLocation = "C:\blabla" & industry & dttoday & ".xlsx"
                sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=saveLocation, fileFilter:="Excel Files (*.xlsx), *.xlsx")
                If sFileSaveName <> "False" Then
                    .SaveAs sFileSaveName
                End If
                .Close
            End With
        End If
        
        Unload Me
        
    End Sub