Hello All,
As you all know by now that I am a person with very limited knowledge of VBA. Still I try to make VBAs work for me. Now I have another question for you gurus. I have the following macro. It runs alright if the dates in seven tabs are within the same month. As soon as the dates cross over to next month in any tab, the macro asks for the file to be located. Is this normal to happen? If not, how can I avoid the dialogue box to come up and confuse the users., Also, I will appreciate anyone making this macro smaller and neater.
Thanks a lot
Regards
Asad
As you all know by now that I am a person with very limited knowledge of VBA. Still I try to make VBAs work for me. Now I have another question for you gurus. I have the following macro. It runs alright if the dates in seven tabs are within the same month. As soon as the dates cross over to next month in any tab, the macro asks for the file to be located. Is this normal to happen? If not, how can I avoid the dialogue box to come up and confuse the users., Also, I will appreciate anyone making this macro smaller and neater.
Code:
Sub NewGAP()
pw = InputBox("Please enter password to run this macro")
If pw = "bus" Then
Dim rng As Range, d As Date, rngB As Range, fd As Date
Dim fp1 As String, fp2 As String, fp3 As String, fp4 As String, fp5 As String, fp6 As String, fp7 As String
Dim c As Range
Sheets("Sunday").Activate
With ActiveSheet
d = InputBox("Please enter date for which you want the GAP file.")
Range("E1").Value = d
fp1 = "'S:\Rosters\[FY17 Gap projections - " & Range("B4").Value & ".xlsx]" & Range("A4").Value & "'!"
Set rng = .Range("A6", "A30")
rng.Formula = "=Index(" & fp1 & "$B$1:$T$1000,Match($C$4," & fp1 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:A6)+8)"
Set rngB = .Range("B6", "D30")
Set rngC = .Range("G6", "I30")
rngB.Formula = "=Round(Index(" & fp1 & "$B$1:$T$1000,Match($C$4," & fp1 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:B6)+8),0)"
rngC.Formula = "=Round(Index(" & fp1 & "$B$1:$T$1000,Match($C$4," & fp1 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:G6)+8),0)"
End With
Sheets("Monday").Activate
With ActiveSheet
fp2 = "'[FY17 Gap projections - " & Range("B4").Value & ".xlsx]" & Range("A4").Value & "'!"
Set rng = .Range("A6", "A30")
rng.Formula = "=Index(" & fp2 & "$B$1:$T$1000,Match($C$4," & fp2 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:A6)+8)"
Set rngB = .Range("B6", "D30")
Set rngC = .Range("G6", "I30")
rngB.Formula = "=Round(Index(" & fp2 & "$B$1:$T$1000,Match($C$4," & fp2 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:B6)+8),0)"
rngC.Formula = "=Round(Index(" & fp2 & "$B$1:$T$1000,Match($C$4," & fp2 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:G6)+8),0)"
End With
Sheets("Tuesday").Activate
With ActiveSheet
fp3 = "'[FY17 Gap projections - " & Range("B4").Value & ".xlsx]" & Range("A4").Value & "'!"
Set rng = .Range("A6", "A30")
rng.Formula = "=Index(" & fp3 & "$B$1:$T$1000,Match($C$4," & fp3 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:A6)+8)"
Set rngB = .Range("B6", "D30")
Set rngC = .Range("G6", "I30")
rngB.Formula = "=Round(Index(" & fp3 & "$B$1:$T$1000,Match($C$4," & fp3 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:B6)+8),0)"
rngC.Formula = "=Round(Index(" & fp3 & "$B$1:$T$1000,Match($C$4," & fp3 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:G6)+8),0)"
End With
Sheets("Wednesday").Activate
With ActiveSheet
fp4 = "'[FY17 Gap projections - " & Range("B4").Value & ".xlsx]" & Range("A4").Value & "'!"
Set rng = .Range("A6", "A30")
rng.Formula = "=Index(" & fp4 & "$B$1:$T$1000,Match($C$4," & fp4 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:A6)+8)"
Set rngB = .Range("B6", "D30")
Set rngC = .Range("G6", "I30")
rngB.Formula = "=Round(Index(" & fp4 & "$B$1:$T$1000,Match($C$4," & fp4 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:B6)+8),0)"
rngC.Formula = "=Round(Index(" & fp4 & "$B$1:$T$1000,Match($C$4," & fp4 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:G6)+8),0)"
End With
Sheets("Thursday").Activate
With ActiveSheet
fp5 = "'[FY17 Gap projections - " & Range("B4").Value & ".xlsx]" & Range("A4").Value & "'!"
Set rng = .Range("A6", "A30")
rng.Formula = "=Index(" & fp5 & "$B$1:$T$1000,Match($C$4," & fp5 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:A6)+8)"
Set rngB = .Range("B6", "D30")
Set rngC = .Range("G6", "I30")
rngB.Formula = "=Round(Index(" & fp5 & "$B$1:$T$1000,Match($C$4," & fp5 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:B6)+8),0)"
rngC.Formula = "=Round(Index(" & fp5 & "$B$1:$T$1000,Match($C$4," & fp5 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:G6)+8),0)"
End With
Sheets("Friday").Activate
With ActiveSheet
fp6 = "'[FY17 Gap projections - " & Range("B4").Value & ".xlsx]" & Range("A4").Value & "'!"
Set rng = .Range("A6", "A30")
rng.Formula = "=Index(" & fp6 & "$B$1:$T$1000,Match($C$4," & fp6 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:A6)+8)"
Set rngB = .Range("B6", "D30")
Set rngC = .Range("G6", "I30")
rngB.Formula = "=Round(Index(" & fp6 & "$B$1:$T$1000,Match($C$4," & fp6 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:B6)+8),0)"
rngC.Formula = "=Round(Index(" & fp6 & "$B$1:$T$1000,Match($C$4," & fp6 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:G6)+8),0)"
End With
Sheets("Saturday").Activate
With ActiveSheet
fp7 = "'[FY17 Gap projections - " & Range("B4").Value & ".xlsx]" & Range("A4").Value & "'!"
Set rng = .Range("A6", "A30")
rng.Formula = "=Index(" & fp7 & "$B$1:$T$1000,Match($C$4," & fp7 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:A6)+8)"
Set rngB = .Range("B6", "D30")
Set rngC = .Range("G6", "I30")
rngB.Formula = "=Round(Index(" & fp7 & "$B$1:$T$1000,Match($C$4," & fp7 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:B6)+8),0)"
rngC.Formula = "=Round(Index(" & fp7 & "$B$1:$T$1000,Match($C$4," & fp7 & "$B$1:$B$1000,0)+ Rows(A$6:A6)-1, Columns($A6:G6)+8),0)"
End With
Else:
Call MsgBox("You do not have the permission to run this macro.")
Exit Sub
End If
fd = d + 6
ActiveWorkbook.SaveAs Filename:="S:\Planning and scheduling\Rosters\Bus Check\Bus Capacity Check - Week Ending " & Format(fd, "dd mmmm yyyy") & ".xlsm"
End Sub
Thanks a lot
Regards
Asad