Hi there,
I currently have this code whereby it extracts a worksheet and saves into a new workbook.
I am trying to make it extract from row 5 and below.
From columns O-U are locations 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
I have a userform interface with checkboxes.
I want the code to program so if you select a checkbox it extracts the specific columns according to that checkbox. You can see the columns I want to be extracted:
Marston Green: B:O
Test Engineering: B:N,P:P
West Hartford: B:N,Q:Q
Singapore: B:B,R:R
Xiamen: B:B,S:S
Neuss: B:B,T:T
Dubai: B:N,U:U
Also if its possible to extract two checkboxes at once. Because I try to do this and it says 'cannot changed part of merged cell.' Also when I run the code the 'save as filename' doesn't work.
Here is the code I currently have:
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")
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
If cbxMarstonGreen = True Then
Range("B5:O1048576").Copy
End If
If cbxTestEngineering = True Then
Range("B:N,P:P").Copy
End If
If cbxWestHartford = True Then
Range("B:N,Q:Q").Copy
End If
If cbxSingapore = True Then
Range("B:N,R:R").Copy
End If
If cbxXiamen = True Then
Range("B:N,S:S").Copy
End If
If cbxNeuss = True Then
Range("B:N,T:T").Copy
End If
If cbxDubai = True Then
Range("B:N,U:U").Copy
End If
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
Thanks
Bookmarks