-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathWeekly FX Rate Update
60 lines (43 loc) · 2.02 KB
/
Weekly FX Rate Update
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub ImportFxRates()
Dim CurrentDate As String
Dim FileDate As String
Const fxfilepath As String = "\\MERCER.COM\US_HOME\NYC4\JULIA-CHONG\Exchange Rates\"
Const UTCfilepath As String = "K:\Client Interface\Client Files\United Tech Corp\FX Tracking\"
Dim UTCfilename As String
Dim fxfilename As String
Dim fxwb As Workbook
Dim wfwb As Workbook
Dim LastCol As Long
Dim FirstErrorValue As Long
Dim LastErrorValue As Long
Dim ErrorRange As Range
Dim Tables As Worksheet
Dim pw As String
Dim OutApp As Object
Dim OutMail As Object
UTCfilename = UTCfilepath & "New Format June 2019_Ongoing Working File.xls"
Set wfwb = Workbooks.Open(UTCfilename)
CurrentDate = Format(Date, "yyyymmdd")
FileDate = Format(Date, "dd mmm yyyy")
fxfilename = fxfilepath & "exch_rates_" & CurrentDate & ".xlsx"
Set fxwb = Workbooks.Open(fxfilename)
If fxwb Is Nothing Then Exit Sub
fxwb.Activate
ActiveWorkbook.Worksheets(1).Range("B3:B152").Select
Selection.Copy
wfwb.Worksheets(2).Activate
LastCol = Cells(4, ActiveWorkbook.Worksheets(2).Columns.Count).End(xlToLeft).Column
ActiveWorkbook.Worksheets(2).Cells(4, LastCol).Offset(0, 1).PasteSpecial
wfwb.Worksheets(1).Cells.EntireColumn.Hidden = False
ActiveWorkbook.Save
wfwb.Worksheets(1).Activate
FirstErrorValue = Cells.Find(What:="#DIV/0!", After:=Range("O3"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
LastErrorValue = Cells.Find(What:="#DIV/0!", After:=Range("O3"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
ActiveWorkbook.Worksheets(1).Range(Cells(1, FirstErrorValue), Cells(1, LastErrorValue)).EntireColumn.Hidden = True
wfwb.Worksheets(2).Visible = False
Set Tables = wfwb.Worksheets(1)
pw = "roscoe"
Tables.Protect Password:=pw, DrawingObjects:=False, Scenarios:=False, UserInterfaceOnly:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
ActiveWorkbook.Protect Password:=pw
wfwb.SaveAs Filename:=UTCfilepath & "UTC FX Tracking_" & FileDate
End Sub