Export based on criteria and save as single separate workbooks

K

Kersh82

New Member
Joined
May 15, 2024
Messages
1
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
You must log in or register to reply here.

Similar threads

C
  • Solved
VBA - Checking for Duplicates
Replies
2
Views
272
cwhaley1
C
E
  • Question
Excel VBA to Outlook Email Draft - How to save email draft copy to sharepoint / How to use template from sharepoint?
Replies
0
Views
433
elitef
E
I
  • Question
VBA - Copy Sheet from a workbook saved as a date - paste to specifically named sheet in another workbook based on the date
Replies
2
Views
486
Insurance Dave
I
G
  • Solved
application.saveasfilename not working
Replies
1
Views
332
grabrail
G
S
  • Solved
VBA: Am I double-calling a Sub given nested If statements? Or other inefficiencies?
Replies
8
Views
322
dreid1011
dreid1011

Forum statistics

Threads
1,217,089
Messages
6,134,497
Members
449,874
Latest member
Cl2130

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top