Option Explicit
Dim Firstrow As Long
Dim lastRow As Long
Dim lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim fileToOpen As String
Dim foundCol As Range
Dim WB1 As Workbook, WB2 As Workbook
Dim myColumns As Variant, myCol As Variant
Dim colCopy As Long, colPaste As Long
Dim LR As Long, LR1 As Long, LR2 As Long, LR3 As Long, LR4 As Long, LR5 As Long, LR6 As Long, LR7 As Long
Dim rng As Range
Dim dt As String
Dim myfile As String
Dim XL As String
Dim XL1 As String
Dim RngOne As Range, Cell As Range
Dim arrList() As String, lngCnt As Long
Dim msg
Dim fName As String
Dim fName1 As String
Dim fPath As String
Sub A_MONTH1()
fPath = Worksheets("SETUP").Range("C51").Value
fName = Worksheets("SETUP").Range("Q25").Value & ".xlsx"
fName1 = Worksheets("SETUP").Range("Q25").Value
Call File_Exist1
dt = VBA.Format(Now, "YYYY-MM-DD")
myColumns = Array("Rpt_date", "LOB", "SegmentGroup", "Segment", "vendorname", "SiteDesc", "DIRECTOREMP_NO", "Director", "manageremp_no", "Manager", "tmemp_no", "Tm_name", "emp_no", "Agt_name", "Metric", "Actual", "Budget", "YEE04", "YEE07", "YEE10", "Budget_Variance", "YEE04_Variance", "YEE07_Variance", "YEE10_Variance", "Trend")
XL = Worksheets("SETUP").Range("M27").Value
XL1 = Worksheets("SETUP").Range("M29").Value
On Error GoTo RuhRoh
Application.Visible = False
Application.Wait (Now() + TimeValue("00:00:01"))
Sheets("SITE").Visible = xlSheetVisible
Worksheets("SITE").Unprotect Password:="Rascal2017"
Sheets("SITE").Select
With Worksheets("SITE")
Rows("1:1").Select
Selection.AutoFilter
lastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
ActiveSheet.Range("$A$1:$AE" & lastRow).AutoFilter Field:=27, Criteria1:=XL, _
Operator:=xlOr, Criteria2:=XL1
Call RemoveHiddenRows
End With
Sheets("SITE_C").Visible = xlSheetVisible
Worksheets("SITE_C").Unprotect Password:="Rascal2017"
Sheets("SITE_C").Select
Set WB1 = ThisWorkbook
With WB1.Sheets("SITE_C")
LR1 = Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A1:Y" & LR1).ClearContents
.Range("A1:Y1").Value = myColumns
End With
With WB1.Worksheets("FORMAT")
Set RngOne = .Range("D28:D57")
End With
lngCnt = 0
For Each Cell In RngOne
ReDim Preserve arrList(lngCnt)
arrList(lngCnt) = Cell.Text
lngCnt = lngCnt + 1
Next
Application.Visible = False
Workbooks.Open FileName:=fPath & Application.PathSeparator & fName
Application.Visible = False
Application.EnableEvents = False
Set WB2 = ActiveWorkbook
WB2.Sheets("ExportData").Select
With WB2.Sheets("ExportData")
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
Columns.EntireColumn.Hidden = False
Rows.EntireRow.Hidden = False
.Range("A1").AutoFilter Field:=13, Criteria1:=arrList, Operator:=xlFilterValues
LR2 = Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each myCol In myColumns
Set foundCol = .Rows(1).Find(myCol)
If Not foundCol Is Nothing Then
colCopy = foundCol.Column
.Range(.Cells(2, colCopy), .Cells(LR2, colCopy)).COPY
Set foundCol = WB1.Sheets("SITE_C").Rows(1).Find(myCol)
colPaste = foundCol.Column
WB1.Sheets("SITE_C").Cells(2, colPaste).PasteSpecial xlPasteValues
End If
Next myCol
End With
Application.CutCopyMode = False
WB2.Close False
Application.Visible = False
Application.Wait (Now() + TimeValue("00:00:01"))
Sheets("SITE").Visible = xlSheetVisible
Worksheets("SITE").Unprotect Password:="Rascal2017"
Sheets("SITE_C").Select
LR4 = Range("A2").End(xlDown).Offset(1).Row
Range("A2:Y" & LR4).COPY
Sheets("SITE").Select
LR5 = Range("A2").End(xlDown).Offset(1).Row
Range("A" & LR5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SITE").Select
Application.Wait (Now() + TimeValue("00:00:01"))
With Sheets("SITE")
LR5 = Range("A2").End(xlDown).Offset(1).Row
Range("Z2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(IF(RC1="""","""",TEXT(RC1,""YYYY-MM-DD"")),""--"")"
Selection.AutoFill Destination:=Range("Z2:Z" & LR5)
Range("AA2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(TEXT(RC26,""M""),""--"")"
Selection.AutoFill Destination:=Range("AA2:AA" & LR5)
End With
With ThisWorkbook.Sheets("SITE")
.Calculate
End With
Application.Wait (Now() + TimeValue("00:00:01"))
With Sheets("SITE")
If .FilterMode Then .ShowAllData
LR6 = Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A2:AA" & LR6).Sort _
Key1:=Range("J2"), Order1:=xlAscending
.Range("A1", "AA" & LR6).Font.Name = "Constantia"
.Range("A1", "AA" & LR6).HorizontalAlignment = xlLeft
.Range("A1", "AA" & LR6).VerticalAlignment = xlCenter
.Range("A1", "AA" & LR6).Font.Size = 8
.Range("A2", "AA" & LR6).Font.Color = vbBlack
End With
LR7 = Cells(Rows.Count, "A").End(xlUp).Row + 1
Set rng = Range("A2:AA" & LR7)
With rng.Borders
.LineStyle = xlContinuous
.Color = vbBlack
.Weight = xlThin
End With
Worksheets("SITE").Range("AB1").Value = dt
Worksheets("SITE").Range("AC1").Value = "Yes"
With Worksheets("SITE")
.Protect Password:="Rascal2017", userinterfaceonly:=False, AllowSorting:=False, AllowFiltering:=False
.EnableOutlining = False
End With
Worksheets("SITE").Visible = xlSheetHidden
Worksheets("SITE_C").Visible = xlSheetHidden
ThisWorkbook.Save
Call HOME
Application.Visible = True
Exit Sub
RuhRoh:
If err.Number <> 0 Then MsgBox "We seem to have encountered an error during upload!", vbOKOnly, "BDH Enterprises (C) 2019-07-20"
ThisWorkbook.Save
Call HOME
Application.Visible = True
End Sub