Option Explicit
Private LastrowMaster As Long, LastrowInput As Long, returnCount As Long, LastrowCT As Long, i As Long, j As Long
Private YearR As String, Period As String, MonthR As String, InputName As String, AMonth As String
Private WS1 As String, WS2 As String, WS3 As String, WS4 As String, Path As String, OPath As String, Filename As String, Plant As String
Private MainWB As Workbook, InputWB As Workbook, OutputWB As Workbook
Private Sht As Worksheet
Private myrange As Range, rng As Range, cell As Range, Area As Range
Private FSO As New FileSystemObject
Private C1 As Long, C2 As Long
Sub InvLedgerCharts()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False
Set MainWB = ThisWorkbook
YearR = Year(MainWB.Worksheets("Procedure").Range("C3"))
MonthR = Format(MainWB.Worksheets("Procedure").Range("C3"), "MMMM")
AMonth = Format(MainWB.Worksheets("Procedure").Range("C3").Value + 1, "MM""/""dd""/""yyyy")
Period = Format(month(MainWB.Worksheets("Procedure").Range("C3")), "00")
InputName = YearR & Period & " - INV (K2gen).xlsx"
WS1 = "InventoryLedger"
WS2 = "Pivot"
WS3 = "Aging"
WS4 = "Summary"
Path = "[Confidential]\0Input\" 'Path where the files are
OPath = "[Confidential]\0Output\" 'Path where the files are put when done
Filename = Path & InputName
Workbooks.Open Filename
Set InputWB = ActiveWorkbook
Set Sht = ActiveWorkbook.ActiveSheet
LastrowInput = Sht.Range("A" & Rows.Count).End(xlUp).Row
If LastrowInput < 500 Then
MsgBox InputName & " file's not complete. There is less then 500 records. There should be more. Please validate and rerun macro.'", vbExclamation, "[Confidential]"
InputWB.Close SaveChanges:=False
Exit Sub
End If
LastrowMaster = MainWB.Worksheets(WS1).Range("A" & Rows.Count).End(xlUp).Row
MainWB.Worksheets(WS1).Rows("7:" & LastrowMaster).EntireRow.Delete
MainWB.Worksheets(WS1).Range("C6:BI" & LastrowInput).Value = Sht.Range("A6:BG" & LastrowInput).Value
MainWB.Worksheets(WS1).Range("A6:B" & LastrowInput).Formula = MainWB.Worksheets(WS1).Range("A6:B6").Formula
MainWB.Worksheets(WS1).Range("BJ6:BP" & LastrowInput).Formula = MainWB.Worksheets(WS1).Range("BJ6:BP6").Formula
LastrowMaster = MainWB.Worksheets(WS1).Range("A" & Rows.Count).End(xlUp).Row
InputWB.Close SaveChanges:=False
Filename = Dir(Path & "[Confidential]" & "*.xlsx")
Do While Filename <> ""
Workbooks.Open Path & Filename
Plant = ActiveWorkbook.ActiveSheet.Range("D2").Value
Set InputWB = ActiveWorkbook
Set Sht = ActiveWorkbook.ActiveSheet
LastrowInput = Sht.Range("A" & Rows.Count).End(xlUp).Row
With Sht.Range("A1:AF" & LastrowInput)
.AutoFilter Field:=4, Criteria1:="<>" & Plant
.AutoFilter Field:=6, Criteria1:="<>[Confidential]"
.AutoFilter Field:=14, Operator:=xlFilterValues, Criteria2:=Array(1, AMonth)
End With
Set myrange = Sht.Range("A1:A" & LastrowInput).SpecialCells(xlCellTypeVisible)
returnCount = WorksheetFunction.Subtotal(3, myrange) - 1
If returnCount > 0 Then
With MainWB.Worksheets(WS1)
Sht.Range("D2:D" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("C" & LastrowMaster + 1 & ":C" & LastrowMaster + returnCount)
.Range("E" & LastrowMaster + 1 & ":E" & LastrowMaster + returnCount).Value = Plant
Sht.Range("Z2:Z" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("F" & LastrowMaster + 1 & ":F" & LastrowMaster + returnCount)
Sht.Range("AA2:AA" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("G" & LastrowMaster + 1 & ":G" & LastrowMaster + returnCount)
Sht.Range("J2:J" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("H" & LastrowMaster + 1 & ":H" & LastrowMaster + returnCount)
Sht.Range("K2:K" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("I" & LastrowMaster + 1 & ":I" & LastrowMaster + returnCount)
Sht.Range("H2:H" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("J" & LastrowMaster + 1 & ":J" & LastrowMaster + returnCount)
Sht.Range("I2:I" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("K" & LastrowMaster + 1 & ":K" & LastrowMaster + returnCount)
Sht.Range("U2:U" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("L" & LastrowMaster + 1 & ":L" & LastrowMaster + returnCount)
Sht.Range("W2:W" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("M" & LastrowMaster + 1 & ":M" & LastrowMaster + returnCount)
Sht.Range("N2:N" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("N" & LastrowMaster + 1 & ":N" & LastrowMaster + returnCount)
Sht.Range("R2:R" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("T" & LastrowMaster + 1 & ":T" & LastrowMaster + returnCount)
Sht.Range("X2:X" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("U" & LastrowMaster + 1 & ":U" & LastrowMaster + returnCount)
Sht.Range("Y2:Y" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("V" & LastrowMaster + 1 & ":V" & LastrowMaster + returnCount)
Sht.Range("P2:P" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("W" & LastrowMaster + 1 & ":W" & LastrowMaster + returnCount)
Sht.Range("M2:M" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("Y" & LastrowMaster + 1 & ":Y" & LastrowMaster + returnCount)
Sht.Range("L2:L" & LastrowInput).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("Z" & LastrowMaster + 1 & ":Z" & LastrowMaster + returnCount)
.Rows(LastrowMaster).Copy
.Range("A" & LastrowMaster + 1 & ":BN" & LastrowMaster + returnCount).PasteSpecial Paste:=xlPasteFormats
.Range("A" & LastrowMaster + 1 & ":BN" & LastrowMaster + returnCount).Interior.Color = 65535
End With
LastrowCT = MainWB.Worksheets(WS1).Range("A" & Rows.Count).End(xlUp).Row
LastrowMaster = MainWB.Worksheets(WS1).Range("C" & Rows.Count).End(xlUp).Row
End If
InputWB.SaveAs OPath & YearR & Period & " - [Confidential] - " & Plant & ".xlsx"
InputWB.Close
If Dir(Path & Filename) <> "" Then Kill Path & Filename
Filename = Dir(Path & "[Confidential]" & "*.xlsx")
Loop
Set rng = MainWB.Worksheets(WS1).Range("A" & LastrowCT & ":BP" & LastrowMaster)
'.SpecialCells(xlCellTypeConstants)
For Each Area In rng.Areas
Area.Value = Evaluate("IF(ROW(" & Area.Address & "),CLEAN(TRIM(" & Area.Address & ")))")
Next Area
'For Each cell In rng.Cells
' cell.Value = Application.WorksheetFunction.Clean(Trim(cell.Value))
'Next cell
MainWB.Worksheets(WS1).Range("A6:B" & LastrowMaster).Formula = MainWB.Worksheets(WS1).Range("A6:B6").Formula
MainWB.Worksheets(WS1).Range("BJ6:BP" & LastrowMaster).Formula = MainWB.Worksheets(WS1).Range("BJ6:BP6").Formula
MainWB.SlicerCaches("[Confidential]").ClearManualFilter
MainWB.SlicerCaches("[Confidential]").ClearManualFilter
MainWB.Worksheets(WS2).PivotTables("Pivot3").ChangePivotCache MainWB.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=MainWB.Worksheets(WS1).Range("A5", "BN" & LastrowMaster))
MainWB.Worksheets(WS2).PivotTables("Pivot3").PivotCache.Refresh
MainWB.Worksheets(WS3).PivotTables("Pivot1").ChangePivotCache MainWB.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=MainWB.Worksheets(WS1).Range("A5", "BN" & LastrowMaster))
MainWB.Worksheets(WS3).PivotTables("Pivot1").PivotCache.Refresh
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.AskToUpdateLinks = True
MsgBox "All done! The procedure can continue.", vbOKOnly, "Success!"
End Sub