I have a macro for 4 workbooks. All are exactly the same. However, one of the workbooks gives me a run-time error message, as well as sometimes giving me a range of error message.
Here is my code:
I can't figure out why 3 of my workbooks work but the last one doesn't. Can someone please advise? Also, after the macro fails to run, I'm unable to click on anything. Workbook isn't protected. Seems corrupted.
Here is my code:
Code:
Sub UpdateEmployeeAllocationList()
'Automatically update Employee Allocation List with 2 latest files to account for terminations.
Dim Main As Workbook
Dim Month As Workbook
'Optimization
Application.ScreenUpdating = False
R = "B4:L2000"
R1 = "A3:K1000"
Range(R).Clear
Set Main = ThisWorkbook
file = Range("A1").Value
Set Month = Workbooks.Open("S:\NPH Accounting\NPH Accounting Department\Allocations\2016\Employee Allocation\" & file & " Employee Allocations 2016.xlsx")
'the below is the workbook where the data will be copied from it is getting activated
Month.Activate
Month.Sheets("Employee Allocation List").Select
'now when the above workbook is activated the data from its active sheet will be selected and copied
Month.Sheets("Employee Allocation List").Range(R1).Select
Application.CutCopyMode = False
Selection.Copy
'now the sheet where you are running this macro from is being activated
Main.Activate
'Now you will select and change focus to the sheet where you want to copy your data
Main.Sheets("Employee Allocation List").Activate
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Determine which month data is from.
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Month.Close False
Range("A4:L4").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Columns("H:L").Select
Selection.NumberFormat = "0.00%"
'Now for 2nd Employee Allocation List
R = "B4:L2000"
R1 = "A4:K1000"
Set Main = ThisWorkbook
file2 = Range("A2").Value
Set Month2 = Workbooks.Open("S:\NPH Accounting\NPH Accounting Department\Allocations\2016\Employee Allocation\" & file2 & " Employee Allocations 2016.xlsx")
'the below is the workbook where the data will be copied from it is getting activated
Month2.Activate
Month2.Sheets("Employee Allocation List").Select
'now when the above workbook is activated the data from its active sheet will be selected and copied
Month2.Sheets("Employee Allocation List").Range(R1).Select
Application.CutCopyMode = False
Selection.Copy
'now the sheet where you are running this macro from is being activated
Main.Activate
'Now you will select and change focus to the sheet where you want to copy your data
Main.Sheets("Employee Allocation List").Activate
Range("B1999").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(1).Select
ActiveCell.Offset(-1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Month2.Close False
'Delete duplicates from employee allocation list
ActiveSheet.Range("$A$4:$O$2000").AutoFilter Field:=15, Criteria1:= _
"Duplicate"
Range("A5:O2000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.Range("$A$4:$O$2000").AutoFilter Field:=15
'Add Formulated rows for next update
Range("A5").Select
Selection.Copy
Range("A5:A2000").Select
ActiveSheet.Paste
Range("N5:O5").Select
Selection.Copy
Range("N5:O2000").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
'To the Top!
Application.Goto Reference:=Range("a1"), Scroll:=True
End Sub
I can't figure out why 3 of my workbooks work but the last one doesn't. Can someone please advise? Also, after the macro fails to run, I'm unable to click on anything. Workbook isn't protected. Seems corrupted.