VBA to extract worksheet according to a specific filter criteria

[sdhutty]

Hi there,

I currently have a worksheet labelled "Register".

I have this code whereby it extracts the worksheet and provides the 'save as' option to a folder.

The worksheet has headers and filters. The columns: O-U are labelled as follows:

Column O: Marston Green
Column P: Test Engineering
Column Q: West Hartford
Column R: Singapore
Column S: Xiamen
Column T: Neuss
Column U:Dubai

These columns are of True/False cells only.

What I also want to do for the current coding I have is two things:

1) When It runs, a message box appears stating which location would you like to extract out of the above & the option for criteria True or False.

2) When the Register worksheet is extracted, the new worksheet doesn't have the filters on anymore. So the new worksheet is essentially a print screen of what has been extracted from the Register worksheet.

Here is the current coding I have:

Sub ExtractWorksheet()
If MsgBox("This will begin the process to extract the 'Register' worksheet. Proceed?", vbYesNo) = vbNo Then Exit Sub
    Dim wb As Workbook, InitFileName As String, fileSaveName As String
     
    InitFileName = ThisWorkbook.Path & "\ Extracted_Register_" & Format(Date, "dd-mm-yyyy")
     
    Sheets("Register").Copy
     ' or below for more than one sheet
     ' Sheets(Array("Output", "Sheet2", "Sheet3")).Copy
     
    Set wb = ActiveWorkbook
     
    fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitFileName, _
    filefilter:="Excel files , *.xlsx")
     
    With wb
        If fileSaveName <> "False" Then
             
            .SaveAs fileSaveName
            .Close
        Else
            .Close False
            Exit Sub
        End If
    End With
     
End Sub

Thanks

 

[sdhutty]

More info regarding this problem to make it more clear:

The data within these columns are of True/False only and the data begins on row 6.

I have created a userform interface that when ran allows the user to select a location out of the above via checkboxes and there are also three option buttons: True, False, Both.

What I'm trying to do with this userform interface is as follows:

1)

When you select a location and select True. It will filter True for that location and extract the worksheet.

When you select a location and select False it will filter False for that location extract the worksheet.

When you select a location and select BOTH true and false it will just extract the worksheet.

If one location doesn't have any True/False options and the user selects True/False and presses 'extract' - a notification will come up stating "No true/false options for this location- please amend search".

2)

The extracted worksheet doesn't have filters function on. So there are no filters on the extracted worksheet.


Forget the coding above, below is the coding within the userform which applies to the problem:

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdClear_Click()
'Clear the form
    For Each ctl In Me.Controls
    If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
        ctl.Value = ""
    ElseIf TypeName(ctl) = "CheckBox" Then
        ctl.Value = False
    End If
   Next ctl
End Sub
Private Sub cmdExtract_Click()
If MsgBox("                      Please Confirm", vbYesNo) = vbNo Then Exit Sub
Application.DisplayAlerts = False
Dim wb As Workbook, InitFileName As String, fileSaveName As String
    
    InitFileName = ThisWorkbook.Path & "\ Extracted_Register_" & Format(Date, "dd-mm-yyyy")
     
    Sheets("Register").Copy
     ' or below for more than one sheet
     ' Sheets(Array("Output", "Sheet2", "Sheet3")).Copy
     
    Set wb = ActiveWorkbook
     
    fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitFileName, _
    filefilter:="Excel files , *.xlsx")
    
     With wb
        If fileSaveName <> "False" Then
             
            .SaveAs fileSaveName
            .Close
        Else
            .Close False
            Exit Sub
        End If
    End With

    
MsgBox ("Extraction Completed")
Unload Me
Application.DisplayAlerts = True
End Sub

Private Sub UserForm_Click()

End Sub