Snasui Excel Forum

Code: Select all

Sub BOT()
'
' BOT Macro
'

'
'    With ActiveSheet.QueryTables.Add(Connection:= _
'        "URL;https://www.bot.or.th/English/Statistics/FinancialMarkets/ExchangeRate/_layouts/Application/ExchangeRate/ExchangeRate.aspx" _
'        , Destination:=Range("$Z$200"))
'        .Name = "ExchangeRate"
'        .FieldNames = True
'        .RowNumbers = False
'        .FillAdjacentFormulas = False
'        .PreserveFormatting = True
'        .RefreshOnFileOpen = False
'        .BackgroundQuery = True
'        .RefreshStyle = xlInsertDeleteCells
'        .SavePassword = False
'        .SaveData = True
'        .AdjustColumnWidth = True
'        .RefreshPeriod = 0
'        .WebSelectionType = xlEntirePage
'        .WebFormatting = xlWebFormattingNone
'        .WebPreFormattedTextToColumns = True
'        .WebConsecutiveDelimitersAsOne = True
'        .WebSingleBlockTextImport = False
'        .WebDisableDateRecognition = False
'        .WebDisableRedirections = False
'        .Refresh BackgroundQuery:=False
'    End With
'    ActiveWindow.SmallScroll Down:=84
'    ActiveWindow.LargeScroll Down:=8
    With ActiveSheet
        DoEvents
        .Range("z200").QueryTable.Refresh False
    End With
    Range("A1:E1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("A2:E2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("A2").Select
    Cells.Find(What:="Foreign Exchange Rates as ", After:=ActiveCell, LookIn _
        :=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Cells.Find(What:="Baht/US Dollar", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    Range("A350").Select
    ActiveSheet.Paste
    Range("A2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=""Weighted-average interbank Exchange Rate ="" & TEXT(R[348]C,""##.###"")"
    Range("A3").Select
    Application.Goto Reference:="R350C1"
    Application.Goto Reference:="R1C1"
    Range("A1:A2").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1:E1").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("A2:E2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("C13").Select
    Application.Goto Reference:="R350C1"
    Selection.ClearContents
    Range("C8").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],C28:C31,2,FALSE)"
    Range("C8").Select
    ActiveWindow.SmallScroll Down:=-9
    Selection.AutoFill Destination:=Range("C8:C26")
    Range("C8:C26").Select
    Range("D8").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],C28:C31,3,FALSE)"
    Range("D8").Select
    Selection.AutoFill Destination:=Range("D8:D26")
    Range("D8:D26").Select
    Range("E8").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],C28:C31,4,FALSE)"
    Range("E8").Select
    Selection.AutoFill Destination:=Range("E8:E26")
    Range("E8:E26").Select
    Range("C8").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.Goto Reference:="R200C26"
    Columns("Z:AE").Select
    Range("Z200").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A8").Select
    MsgBox "Finished", vbInformation
End Sub