Create a PivotTable report with VBA

Iamlaosong

There is a pick report, want to first from the product information to separate the color information, and then based on the storage, name and color to create a pivot table, because the data is changed (structure is unchanged, the number of records will change), each re-creation is cumbersome, so want to make a tool, use VBA to separate colors and create a PivotTable report for others to The code that separates the colors is very good to write, the code that creates the pivot table naturally takes the method of recording the macro The simplest, the code comes out to modify after the line. The tool interface is as follows:

The contents of the picking list are as follows and need to separate the colors in the SKU information:

The code for the tool is as follows:

' Separation Information sub Separate_information () on Error GoTo Err thisfile = Thisworkbook.name ' The name of this file so that the assignment can be changed arbitrarily workshe ETS ("System parameters"). Select If Cells (2, 2) = "Y" Or cells (2, 2) = "Y" Then ' Export the library file application.screenupd ating = True Else application.screenupdating = False End If ' curdate = Cells (2, 2) ' Pos_qsh = cells    (2, 7) ' Pos_sku = ASC (Cells (3, 7))-POS_FST = Cells (2, 7) Pos_sku = Cells (3, 7) Pos_sav = Cells (4, 7) Pos_tag = C         Ells (5, 7) Pos_end = Cells (6, 7) ' If MsgBox ("Start generation of clear data ...", vbOKCancel, "iamlaosong") = vbcancel Then Exit Sub Lineno = [A65536]. End (Xlup).                              Row ' number of files for unit_num = 5 to Lineno ' file loop Datfile = Cells (Unit_num, 2) ' File name Datfullname = thisworkbook.path & ' \ ' & datfile If Dir (Datfullname,    vbnormal) <> vbNullString then Workbooks.Open filename:=datfullname    ' Open order File ext = right (Datfile, 3) If ext = "xls" Then MaxRow = Cells (65536, Pos_sku ). End (Xlup). Row Else maxrow = Cells (1048576, Pos_sku). End (Xlup). Row End If Else MsgBox "Data file does not exist!" ", vbOKOnly," Iamlaosong "Exit Sub End If tag_len = Len (pos_tag) Cells (pos_fst-1 , pos_sav) = Pos_tag Cells (pos_fst-1, Pos_sav). Font.Bold = True ' detach information, take information between Pos_tag and pos_end for row1 = pos_fst to MaxRow ' If row1 = 193 T Hen ' Debug.Print row1 ' End If buf = Cells (Row1, POS_SKU) m1 = INSTR (1, buf , Pos_tag, vbTextCompare) If m1 > 0 Then m2 = INSTR (m1 + Tag_len, buf, Pos_end, vbTextCompare            ) Buf_sel = Mid (BUF, M1 + Tag_len, M2-m1-tag_len) Else Buf_sel = "NotFound" End If Cells (row1, Pos_sav + 0) = Buf_seThe value in the cell is text, converted to numeric TMP = Cells (row1, 7) cells (Row1, 7) = CINT (tmp) Next Row1 ' Build pivot Table pdata1 = activesheet.name & '! R1c1:r "& MaxRow &" C9 "Sheets.add pdata2 = activesheet.name &"! R3c1 "ActiveWorkbook.PivotCaches.Create (Sourcetype:=xldatabase, sourcedata:=pdata1, _ Version:=xlpivotta BLEVERSION12).        Createpivottable Tabledestination:=pdata2, _ tablename:= "picking list pivot table", Defaultversion:=xlpivottableversion12 ' Set pivot table style, table type, no subtotal Cells (3, 1). select        activesheet.pivottables ("Pick List pivot"). PivotFields ("Pick-up storage"). Subtotals (1) = false        activesheet.pivottables ("Pick List pivot"). PivotFields ("Item name"). Subtotals (1) = false        activesheet.pivottables ("Pick List pivot"). PivotFields ("Color:"). Subtotals (1) = false        activesheet.pivottables ("Pick List pivot"). Rowaxislayout xltabularrow      &NBSp;          ' Add row labels and numeric fields (count, sum) with ActiveSheet.PivotTables ("Pick List pivot table"). PivotFields ("Pick-up storage"). Orientation = Xlrowfield. Position = 1 End with with ActiveSheet.PivotTables ("Pick List pivot"). PivotFields ("Item name"). Orientation = Xlrowfield. Position = 2 End with with ActiveSheet.PivotTables ("Pick List pivot"). PivotFields ("Color:"). Orientation = Xlrowfield. Position = 3 End with                activesheet.pivottables ("Pick List" pivot table "). Adddatafield ActiveSheet.PivotTables (_            "pick List pivot"). PivotFields ("Pick Order Number"), "Pick order Number", xlcount        activesheet.pivottables ("Pick List pivot"). Adddatafield activesheet.pivottables ("Pick List pivot" _           ). PivotFields ("Quantity to be Picked"), "total pickup", xlsum                ActiveWorkbook.SaveAs Filename:=thisworkbook.path & "\new" & Datfile ' Activeworkbook.save activewindow.close Win Dows (thisfile). Activate Worksheets ("System parameters"). Select Cells (unit_num, 3) = "Success" Next unit_num MsgBox "Information processing finished!" ", vbOKOnly," Iamlaosong "Exit suberr:msgbox" error # "& Str (Err.Number) & Err.Description &"-Location: "& Row1, vbOKOnly + vbexclamation, "Iamlaosong" End Sub

The resulting PivotTable report looks like this:

Create a PivotTable report with VBA