Export based on criteria and save as single separate workbooks

[Kersh82]

I’m looking for some help with a macro. I’ve used a similar macro about 5 years ago and cannot remember what code I used for it.

I’ve got an existing macro report with a front page where performance information can be generated based on criteria such as data ranges and also by sales rep.
What I’m looking to do is create a new macro on a separate tab of the same workbook where I can extract the Sales Figures by Sales Rep into a brand new workbook. Each Sales Rep should have a new workbook created showing only their figures. So, for example, the click of a button would start a macro which would link to a fold, and I’d see something similar to this PaulSales.xslx, JodySales.xslx etc.

Your help would be much appreciated.

Thanks

Below is the front screenshot of the existing Macro where the detail will come from.

Tried a few functions from what I can remember but my memory isnt great

Code update from comment -

Sub RefreshCriteria()

' Refresh all tables on the Criteria sheet
Dim lo As ListObject
For Each lo In Worksheets("Criteria(Hide before sending)").ListObjects()
lo.QueryTable.Refresh
Next

End Sub

Sub RefreshReport()

' Report SQL and Parameter Declarations
Dim SQL As String
Dim FirstDateFrom As Date
Dim FirstDateTo As Date
Dim SecondDateFrom As Date
Dim SecondDateTo As Date
Dim SalesRep As String
Dim AllSalesRep As String
Dim AssignedTo As String
Dim AllAssignedTo As String
Dim UserGroup As String
Dim AllUserGroup As String
Dim Territory As String
Dim AllTerritory As String
Dim Track As String
Dim AllTrack As String

' Checking for valid dates
' First date from
If IsDate(Worksheets("Parameters").Range("C1").Value) = False Then
MsgBox "From date is not valid"
Exit Sub
Else
FirstDateFrom = Worksheets("Parameters").Range("C1").Value
End If

' First date to
If IsDate(Worksheets("Parameters").Range("C2").Value) = False Then
MsgBox "To date is not valid"
Exit Sub
Else
FirstDateTo = Worksheets("Parameters").Range("C2").Value
End If

' Second date from
If IsDate(Worksheets("Parameters").Range("F1").Value) = False Then
MsgBox "From date is not valid"
Exit Sub
Else
SecondDateFrom = Worksheets("Parameters").Range("F1").Value
End If

' Second date to
If IsDate(Worksheets("Parameters").Range("F2").Value) = False Then
MsgBox "To date is not valid"
Exit Sub
Else
SecondDateTo = Worksheets("Parameters").Range("F2").Value
End If


' Get the parameters as set them in the SQL string
' Sales rep
If Sheet1.Shapes("ComboSalesRep").ControlFormat.Value > 0 Then
SalesRep = Worksheets("Parameters").Range("I3")
Else
SalesRep = "0"
End If
Select Case Worksheets("Parameters").TickAllSalesRep.Value
Case True
AllSalesRep = "1"
Case Else
AllSalesRep = "0"
End Select

' CRM record assigned to user
If Sheet1.Shapes("ComboAssignedTo").ControlFormat.Value > 0 Then
AssignedTo = Worksheets("Parameters").Range("L3")
Else
AssignedTo = "0"
End If
Select Case Worksheets("Parameters").TickAllAssignedTo.Value
Case True
AllAssignedTo = "1"
Case Else
AllAssignedTo = "0"
End Select

' Assigned to user's user group
If Sheet1.Shapes("ComboUserGroup").ControlFormat.Value > 0 Then
UserGroup = Worksheets("Parameters").Range("O2")
Else
UserGroup = "0"
End If
Select Case Worksheets("Parameters").TickAllUserGroup.Value
Case True
AllUserGroup = "1"
Case Else
AllUserGroup = "0"
End Select

' Customer territory
If Sheet1.Shapes("ComboTerritory").ControlFormat.Value > 0 Then
Territory = Worksheets("Parameters").Range("R3")
Else
Territory = "0"
End If
Select Case Worksheets("Parameters").TickAllTerritory.Value
Case True
AllTerritory = "1"
Case Else
AllTerritory = "0"
End Select

' CRM track
If Sheet1.Shapes("ComboTrack").ControlFormat.Value > 0 Then
Track = Worksheets("Parameters").Range("U3")
Else
Track = "0"
End If
Select Case Worksheets("Parameters").TickAllTrack.Value
Case True
AllTrack = "1"
Case Else
AllTrack = "0"
End Select

' Sets SQL for first date range activities/quotes and refreshes connection
SQL = FormSQL.ActivitiesSQL.Text
SQL = Replace(SQL, "@@DateFrom", Format(FirstDateFrom, "yyyy-MM-dd HH:mm:ss"))
SQL = Replace(SQL, "@@DateTo", Format(FirstDateTo, "yyyy-MM-dd HH:mm:ss"))
SQL = Replace(SQL, "@@SalesRep", SalesRep)
SQL = Replace(SQL, "@@AllSalesRep", AllSalesRep)
SQL = Replace(SQL, "@@AssignedTo", AssignedTo)
SQL = Replace(SQL, "@@AllAssignedTo", AllAssignedTo)
SQL = Replace(SQL, "@@UserGroup", UserGroup)
SQL = Replace(SQL, "@@AllUserGroup", AllUserGroup)
SQL = Replace(SQL, "@@Territory", Territory)
SQL = Replace(SQL, "@@AllTerritory", AllTerritory)
SQL = Replace(SQL, "@@Track", Track)
SQL = Replace(SQL, "@@AllTrack", AllTrack)

With ActiveWorkbook.Connections("qry_activitiesfirstdate").ODBCConnection
.BackgroundQuery = False
.CommandText = SQL
.Refresh
End With

' Sets SQL for second date range activities/quotes and refreshes connection
SQL = FormSQL.ActivitiesSQL.Text
SQL = Replace(SQL, "@@DateFrom", Format(SecondDateFrom, "yyyy-MM-dd HH:mm:ss"))
SQL = Replace(SQL, "@@DateTo", Format(SecondDateTo, "yyyy-MM-dd HH:mm:ss"))
SQL = Replace(SQL, "@@SalesRep", SalesRep)
SQL = Replace(SQL, "@@AllSalesRep", AllSalesRep)
SQL = Replace(SQL, "@@AssignedTo", AssignedTo)
SQL = Replace(SQL, "@@AllAssignedTo", AllAssignedTo)
SQL = Replace(SQL, "@@UserGroup", UserGroup)
SQL = Replace(SQL, "@@AllUserGroup", AllUserGroup)
SQL = Replace(SQL, "@@Territory", Territory)
SQL = Replace(SQL, "@@AllTerritory", AllTerritory)
SQL = Replace(SQL, "@@Track", Track)
SQL = Replace(SQL, "@@AllTrack", AllTrack)

With ActiveWorkbook.Connections("qry_activitiesseconddate").ODBCConnection
.BackgroundQuery = False
.CommandText = SQL
.Refresh
End With

' Sets SQL for first date range records and refreshes connection
SQL = FormSQL.RecordsSQL.Text
SQL = Replace(SQL, "@@DateFrom", Format(FirstDateFrom, "yyyy-MM-dd HH:mm:ss"))
SQL = Replace(SQL, "@@DateTo", Format(FirstDateTo, "yyyy-MM-dd HH:mm:ss"))
SQL = Replace(SQL, "@@SalesRep", SalesRep)
SQL = Replace(SQL, "@@AllSalesRep", AllSalesRep)
SQL = Replace(SQL, "@@AssignedTo", AssignedTo)
SQL = Replace(SQL, "@@AllAssignedTo", AllAssignedTo)
SQL = Replace(SQL, "@@UserGroup", UserGroup)
SQL = Replace(SQL, "@@AllUserGroup", AllUserGroup)
SQL = Replace(SQL, "@@Territory", Territory)
SQL = Replace(SQL, "@@AllTerritory", AllTerritory)
SQL = Replace(SQL, "@@Track", Track)
SQL = Replace(SQL, "@@AllTrack", AllTrack)

With ActiveWorkbook.Connections("qry_recordsfirstdate").ODBCConnection
.BackgroundQuery = False
.CommandText = SQL
.Refresh
End With

' Sets SQL for second date range records and refreshes connection
SQL = FormSQL.RecordsSQL.Text
SQL = Replace(SQL, "@@DateFrom", Format(SecondDateFrom, "yyyy-MM-dd HH:mm:ss"))
SQL = Replace(SQL, "@@DateTo", Format(SecondDateTo, "yyyy-MM-dd HH:mm:ss"))
SQL = Replace(SQL, "@@SalesRep", SalesRep)
SQL = Replace(SQL, "@@AllSalesRep", AllSalesRep)
SQL = Replace(SQL, "@@AssignedTo", AssignedTo)
SQL = Replace(SQL, "@@AllAssignedTo", AllAssignedTo)
SQL = Replace(SQL, "@@UserGroup", UserGroup)
SQL = Replace(SQL, "@@AllUserGroup", AllUserGroup)
SQL = Replace(SQL, "@@Territory", Territory)
SQL = Replace(SQL, "@@AllTerritory", AllTerritory)
SQL = Replace(SQL, "@@Track", Track)
SQL = Replace(SQL, "@@AllTrack", AllTrack)

With ActiveWorkbook.Connections("qry_recordsseconddate").ODBCConnection
.BackgroundQuery = False
.CommandText = SQL
.Refresh
End With

' Sets SQL for first date range enquiry records and refreshes connection
SQL = FormSQL.EnquiriesSQL.Text
SQL = Replace(SQL, "@@DateFrom", Format(FirstDateFrom, "yyyy-MM-dd HH:mm:ss"))
SQL = Replace(SQL, "@@DateTo", Format(FirstDateTo, "yyyy-MM-dd HH:mm:ss"))
SQL = Replace(SQL, "@@SalesRep", SalesRep)
SQL = Replace(SQL, "@@AllSalesRep", AllSalesRep)
SQL = Replace(SQL, "@@AssignedTo", AssignedTo)
SQL = Replace(SQL, "@@AllAssignedTo", AllAssignedTo)
SQL = Replace(SQL, "@@UserGroup", UserGroup)
SQL = Replace(SQL, "@@AllUserGroup", AllUserGroup)
SQL = Replace(SQL, "@@Territory", Territory)
SQL = Replace(SQL, "@@AllTerritory", AllTerritory)
SQL = Replace(SQL, "@@Track", Track)
SQL = Replace(SQL, "@@AllTrack", AllTrack)

With ActiveWorkbook.Connections("qry_enquiriesfirstdate").ODBCConnection
.BackgroundQuery = False
.CommandText = SQL
.Refresh
End With

' Sets SQL for second date range enquiry records and refreshes connection
SQL = FormSQL.EnquiriesSQL.Text
SQL = Replace(SQL, "@@DateFrom", Format(SecondDateFrom, "yyyy-MM-dd HH:mm:ss"))
SQL = Replace(SQL, "@@DateTo", Format(SecondDateTo, "yyyy-MM-dd HH:mm:ss"))
SQL = Replace(SQL, "@@SalesRep", SalesRep)
SQL = Replace(SQL, "@@AllSalesRep", AllSalesRep)
SQL = Replace(SQL, "@@AssignedTo", AssignedTo)
SQL = Replace(SQL, "@@AllAssignedTo", AllAssignedTo)
SQL = Replace(SQL, "@@UserGroup", UserGroup)
SQL = Replace(SQL, "@@AllUserGroup", AllUserGroup)
SQL = Replace(SQL, "@@Territory", Territory)
SQL = Replace(SQL, "@@AllTerritory", AllTerritory)
SQL = Replace(SQL, "@@Track", Track)
SQL = Replace(SQL, "@@AllTrack", AllTrack)

With ActiveWorkbook.Connections("qry_enquiriesseconddate").ODBCConnection
.BackgroundQuery = False
.CommandText = SQL
.Refresh
End With

' Sets SQL for open records and refreshes connection
SQL = FormSQL.OpenRecordsSQL.Text
SQL = Replace(SQL, "@@SalesRep", SalesRep)
SQL = Replace(SQL, "@@AllSalesRep", AllSalesRep)
SQL = Replace(SQL, "@@AssignedTo", AssignedTo)
SQL = Replace(SQL, "@@AllAssignedTo", AllAssignedTo)
SQL = Replace(SQL, "@@UserGroup", UserGroup)
SQL = Replace(SQL, "@@AllUserGroup", AllUserGroup)
SQL = Replace(SQL, "@@Territory", Territory)
SQL = Replace(SQL, "@@AllTerritory", AllTerritory)
SQL = Replace(SQL, "@@Track", Track)
SQL = Replace(SQL, "@@AllTrack", AllTrack)

With ActiveWorkbook.Connections("qry_openrecords").ODBCConnection
.BackgroundQuery = False
.CommandText = SQL
.Refresh
End With

' Go to Main report and notify the user
Dim ReportRunInfo As String
ReportRunInfo = "Report refreshed: " + Format(Now(), "dd/MM/yyyy hh:mm") + ". Customer Sales Rep: " + IIf(Worksheets("Parameters").TickAllSalesRep.Value, "All sales reps", Worksheets("Parameters").Range("I2")) + ". Record Assigned To User: " + IIf(Worksheets("Parameters").TickAllAssignedTo.Value, "All assigned to users", Worksheets("Parameters").Range("L2")) + ". User Group: " + IIf(Worksheets("Parameters").TickAllUserGroup.Value, "All user groups", Worksheets("Parameters").Range("O2")) + ". Territory: " + IIf(Worksheets("Parameters").TickAllTerritory.Value, "All territories", Worksheets("Parameters").Range("R2")) + ". Track: " + IIf(Worksheets("Parameters").TickAllTrack.Value, "All tracks", Worksheets("Parameters").Range("U2")) + "."

Worksheets("Completed Activities & Quotes").Range("A3").Value = ReportRunInfo
Worksheets("Completed Activities & Quotes").Range("A5").Value = "Completed activities between " + Format(FirstDateFrom, "dd/MM/yyyy hh:mm") + " and " + Format(FirstDateTo, "dd/MM/yyyy hh:mm") + "."
Worksheets("Completed Activities & Quotes").Range("E5").Value = "Completed activities between " + Format(SecondDateFrom, "dd/MM/yyyy hh:mm") + " and " + Format(SecondDateTo, "dd/MM/yyyy hh:mm") + "."


Worksheets("Closed Records").Range("A3").Value = ReportRunInfo
Worksheets("Closed Records").Range("A5").Value = "Closed records between " + Format(FirstDateFrom, "dd/MM/yyyy hh:mm") + " and " + Format(FirstDateTo, "dd/MM/yyyy hh:mm") + "."
Worksheets("Closed Records").Range("E5").Value = "Closed records between " + Format(SecondDateFrom, "dd/MM/yyyy hh:mm") + " and " + Format(SecondDateTo, "dd/MM/yyyy hh:mm") + "."


Worksheets("Closed Record Enquiries").Range("A3").Value = ReportRunInfo
Worksheets("Closed Record Enquiries").Range("A5").Value = "Closed record enquiries between " + Format(FirstDateFrom, "dd/MM/yyyy hh:mm") + " and " + Format(FirstDateTo, "dd/MM/yyyy hh:mm") + "."
Worksheets("Closed Record Enquiries").Range("I5").Value = "Closed record enquiries between " + Format(SecondDateFrom, "dd/MM/yyyy hh:mm") + " and " + Format(SecondDateTo, "dd/MM/yyyy hh:mm") + "."

Worksheets("Open Records By Period").Range("A3").Value = ReportRunInfo
Worksheets("Open Records By Period").Range("A5").Value = "Open records as of " + Format(Now(), "dd/MM/yyyy") + "."

Sheets("Completed Activities & Quotes").Select
MsgBox "Refresh complete", vbInformation, "59840 - CRM Activity Report"

End Sub
End Sub

[Screenshot][1]


[1]: https://i.sstatic.net/fzM93yc6.jpg