Excel (XLSX) filtering using vba to create a xlsm file

[nick243]

Hi my name is Nick,

I have a question about using xlsx file and filtering/ deleting some information and pasting that information to an xlsm for a cleaner look. It just looks like all the information is filling in but it is not the right information in the right columns. I am having trouble posting screen shots. Here is the code

Dim DistVar, StoreVar, LastRowVar, StoreFileLastRowVar, Dist2Var, DateXVar
Dim DateVar As Date
Dim fso
Dim fol As String
Dim folder, FileName, stDocName As String


Sub Sync()


ActiveWorkbook.RefreshAll
MsgBox "Data Sync to data base."


End Sub


Sub Districts()


'CREATE A FOLDER FOR THIS WEEK'S REQUESTS
folder = "K:\Departments\Shipping\Eric\StoreSupplyProject\ApprovalFiles\"
Range("D3").Select
DateVar = Selection
DateXVar = Format(DateVar, "yyyy_mm_dd")
fol = folder & DateXVar
Call CreateFolder


'CREATE AN APPROVAL FOLDER
'fol = folder & DateXVar & "\ApprovedFiles"
'Call CreateFolder


'CAPTURE THE FIRST DISTRICT NUMBER
Range("B3").Select
DistVar = Selection


'START LOOPING THROUGH THE DIFFERENT DISTRICTS
Do While DistVar <> ""
    
    'MAKE A COPY OF THE BLANK FILE - SAVE AS DISTRICT
    FileCopy "K:\Departments\Shipping\Eric\StoreSupplyProject\ApprovalFiles\BlankDistrictFile2.xlsx", _
        "K:\Departments\Shipping\Eric\StoreSupplyProject\ApprovalFiles\" & DateXVar & "\District_" & DistVar & "_" & Format(Date, "mm-dd-yy") & ".xlsx"
    
    ChDir "K:\Departments\Shipping\Eric\StoreSupplyProject\ApprovalFiles\"
    Workbooks.Open FileName:= _
        "K:\Departments\Shipping\Eric\StoreSupplyProject\ApprovalFiles\" & DateXVar & "\District_" & DistVar & "_" & Format(Date, "mm-dd-yy") & ".xlsx"
    
    Call District
    
    'PLACE COPY ON THE G:\
    FileCopy "K:\Departments\Shipping\Eric\StoreSupplyProject\ApprovalFiles\" & DateXVar & "\District_" & Dist2Var & "_" & Format(Date, "mm-dd-yy") & ".xlsx", _
        "G:\Teams and Projects\DSM Approval-Store Supply Orders\" & Format(DateVar, "mm-dd-yy") & "\District_" & Dist2Var & "_" & Format(Date, "mm-dd-yy") & ".xlsx"
           
    'RESET FOR NEXT DISTRICT
    Windows("MasterDistrictFile2.xlsm").Activate
    Range("B3").Select
    DistVar = Selection
         
Loop


'CLOSE MASTER FILE
ActiveWorkbook.Close


End Sub


Sub District()


Windows("MasterDistrictFile2.xlsm").Activate
'Range("C3").Select
'StoreVar = Selection


Range("B3").Select
DistVar = Selection


Range("B3").Select
Dist2Var = Selection


'START LOOPING THROUGH THE DIFFERENT STORES
Do While DistVar = Dist2Var And DistVar <> ""
    
    'Filter master to next district data
    Windows("MasterDistrictFile2.xlsm").Activate
    ActiveSheet.ListObjects("Table_StoreSupply").Range.AutoFilter Field:=2, Criteria1:=DistVar
    
    'Capture last district row in master
    Range("C3").Select
    Selection.End(xlDown).Select
    LastRowVar = Selection.Row
        
    'Copy store data
    Range("A3:S" & LastRowVar).Select
    Selection.Copy
    
    'Paste store data
    Windows("District_" & DistVar & "_" & Format(Date, "mm-dd-yy") & ".xlsx").Activate
    Range("S6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


    'capture last row on store worksheet
    Range("W6").Select
    Selection.End(xlDown).Select
    StoreFileLastRowVar = Selection.Row
    
    'delete un-needed rows
    Range(StoreFileLastRowVar + 1 & ":50004").Select
    Selection.Delete Shift:=xlUp
   
    'copy values
    Range("A4:I" & StoreFileLastRowVar + 2).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("L4:Q" & StoreFileLastRowVar + 2).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("C3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    'unlock the approved units column
    Range("I5:J" & StoreFileLastRowVar).Select
    Selection.Locked = False
 
    'Delete columns with data
    Columns("S:AJ").Select
    Selection.Delete
     
    'Hide ID column
    Columns("S:S").Select
    Selection.EntireColumn.Hidden = True
    
    'set default view status
    Range("A6").Select
    ActiveWindow.FreezePanes = True
    Range("A5:Q" & StoreFileLastRowVar).Select
    Selection.AutoFilter
    Range("G6").Select
    
    'Delete store rows from master
    Windows("MasterDistrictFile2.xlsm").Activate
    Range("3:" & LastRowVar).Select
    Selection.Delete Shift:=xlUp
    
    'Reset for next store
    ActiveSheet.ListObjects("Table_StoreSupply").Range.AutoFilter Field:=2
    Range("C3").Select
    StoreVar = Selection
    
    Dist2Var = DistVar
    
    Range("B3").Select
    DistVar = Selection
 
Loop


'Lock District file
Windows("District_" & Dist2Var & "_" & Format(Date, "mm-dd-yy") & ".xlsx").Activate
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True


'Save District file
ActiveWorkbook.Save


'Email District file
ActiveWorkbook.SendMail Recipients:="#District" & Dist2Var & "Mgmt", Subject:="District " & Dist2Var & " Supply Order - " & Format(Date, "m/d/yyyy")


'Close District file
ActiveWorkbook.Close


End Sub






Sub CreateFolder()
    Set fso = CreateObject("Scripting.FileSystemObject")
        If Not fso.FolderExists(fol) Then
            fso.CreateFolder (fol)
        End If


     
End Sub

it creates a file for each district.

Thanks for reading through my problem.