简体   繁体   中英

need complex VBA for Excel to split several sheets into many others filtered by column data

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM