OK so I have a issue where I have 5 sheets (one is a list of the filter names) that I need to filter on a Distributors name and create and new sheets in a new workbook to distribute to them. All the source sheet data is coming from a SQL DB, and I would like to be able to run this Macro every time I need to send out reports. Its been awhile since I work with VBA but I used the recorder to record steps for using MS Query to get a basis but I am at a miss on how to automate this for all the sheets and distributor combinations (36 in total). Here is the very primitive start
'
' Sort Macro
'
'
Sheets.Add After:=ActiveSheet
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=CNG_POS;UID=brobbin;Trusted_Connection=Yes;APP=Microsoft Office 2013;WSID=BROBBIN-1Q1Z8;DATABASE=CNG_POS;QueryLog_On=Yes;Mu" _
), Array("ltiSubnetFailover=Yes;")), Destination:=Range("$A$1")).QueryTable
.CommandText = Array( _
"SELECT ""Missing_ORDERS>POS_LOOKUP"".""Fiscal Quarter ID"", ""Missing_ORDERS>POS_LOOKUP"".""ERP End Customer Name"", ""Missing_ORDERS>POS_LOOKUP"".""POS End Customer Master Name"", ""Missing_ORDERS>POS_LOOKUP"".""Da" _
, _
"te Booked"", ""Missing_ORDERS>POS_LOOKUP"".""POS DID"", ""Missing_ORDERS>POS_LOOKUP"".""ERP Deal ID"", ""Missing_ORDERS>POS_LOOKUP"".""Claim Authorization Number"", ""Missing_ORDERS>POS_LOOKUP"".""Sales Order Number " _
, _
"Detail"", ""Missing_ORDERS>POS_LOOKUP"".""Bookings Base List"", ""Missing_ORDERS>POS_LOOKUP"".""Bookings Net"", ""Missing_ORDERS>POS_LOOKUP"".""Bookings Quantity"", ""Missing_ORDERS>POS_LOOKUP"".""S" _
, _
"ales Level 1"", ""Missing_ORDERS>POS_LOOKUP"".""Partner Type"", ""Missing_ORDERS>POS_LOOKUP"".""ERP Bill To Customer Name"", ""Missing_ORDERS>POS_LOOKUP"".""Order Status"", ""Missing_ORDERS>POS_LOOKUP"".""Line Creati" _
, _
"on Date"", ""Missing_ORDERS>POS_LOOKUP"".""Order Source"", ""Missing_ORDERS>POS_LOOKUP"".""POS DISTRIBUTOR NAME"", ""Missing_ORDERS>POS_LOOKUP"".""Product ID"", ""Missing_ORDERS>POS_LOOKUP"".""POS Transaction ID"", ""M" _
, _
"issing_ORDERS>POS_LOOKUP"".""POS Trans Date"", ""Missing_ORDERS>POS_LOOKUP"".""Disti to Reseller Sales Order Date"", ""Missing_ORDERS>POS_LOOKUP"".""Invoice Number"", ""Missing_ORDERS>POS_LOOKUP"".""POS Base List P" _
, _
"rice"", ""Missing_ORDERS>POS_LOOKUP"".""Net POS (Validated) - Global"", ""Missing_ORDERS>POS_LOOKUP"".""Discount %"", ""Missing_ORDERS>POS_LOOKUP"".""Parent line ID"", ""Missing_ORDERS>POS_LOOKUP"".""Line ID""" & Chr(13) & "" & Chr(10) & "FROM C" _
, _
"NG_POS.dbo.""Missing_ORDERS>POS_LOOKUP"" ""Missing_ORDERS>POS_LOOKUP""" & Chr(13) & "" & Chr(10) & "WHERE (""Missing_ORDERS>POS_LOOKUP"".""POS DISTRIBUTOR NAME"" Like 'Tech%')" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub
I would also like to either keep the source table name as the sheet name or make a new string to include the Distributors name.
Any thoughts on how to do this would be greatly appreciated as doing it manually is nearly impossible, and using a MS query isn't required its just one way I could make sure the Distributors data was separate when copying the sheets. I am using excel 2013
OK Here is what I have come up with, however I have had to make several versions for each sheet. In A perfect world I would set Dim C to = values on another sheet. Now the last missing piece is saving the resulting sheets into a new workbook.
Sub ERP_POS()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Dim bAF As Boolean
Set ws1 = Sheets("ERP_POS")
Set rng = Range("Database")
bAF = ws1.AutoFilterMode
'extract a list of Sales Reps
With ws1
.Columns("P:P").Copy _
Destination:=.Range("X1")
.Columns("X:X").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("Y1"), Unique:=True
r = .Cells(Rows.Count, "Y").End(xlUp).Row
.Columns("X:X").ClearContents
'set up Criteria Area
.Range("X1").Value = .Range("P1").Value
For Each c In .Range("Y2:Y" & r)
'add the rep name to the criteria area
.Range("X2").Value = _
"=""="" & " & Chr(34) & c.Value & Chr(34)
'add new sheet (if required)
'and run advanced filter
If WksExists("ERP_POS" & " " & c.Value) Then
Sheets("ERP_POS" & " " & c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("X1:X2"), _
CopyToRange:=Sheets("ERP_POS" & " " & c.Value).Range("A1"), _
Unique:=False
Else
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = "ERP_POS" & " " & c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("X1:X2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
.Select
.Columns("Y:X").EntireColumn.Delete
If bAF = True Then
.Range("A1").AutoFilter
End If
End With
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.