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
    
    Range("C8:E26").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Range("E29").Select
    
    
    MsgBox "Updated rates BOT has finished", vbInformation
    
End Sub