dung help

Sub GetLevels()
    Application.Calculation = xlManual
    cleanup
    Dim ws As Worksheet
    Set ws = ActiveSheet
    Dim c As Range
    Dim r As Range
    If IsEmpty(Range("D1")) Then
        Set r = Cells(1, 3)
    Else
        Set r = Range(Cells(1, 3), Range("C1").End(xlToRight))
    End If

    For Each c In r.Cells
        If Not IsEmpty(c) Then
            GetPlayerLevels c.Value, c.Offset(1, 0)
            With Range(c.Offset(1, 0), c.Offset(25, 0))
                .ColumnWidth = 5
                .Interior.ColorIndex = xlNone
                .FormatConditions.Delete
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
                    , Formula1:="=$A$2"
                .FormatConditions(1).Font.ColorIndex = xlAutomatic
                .FormatConditions(1).Interior.ColorIndex = 4
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
                    , Formula1:="=($A$2-4) / ( 1 + 0.04)"
                With .FormatConditions(2).Interior
                    .ColorIndex = 35
                    .PatternColorIndex = 4
                    .Pattern = xlGray50
                End With
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
                    , Formula1:="=($A$2-6) / ( 1 + 0.06)"
                With .FormatConditions(3).Interior
                    .ColorIndex = 35
                End With

                'borders
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                With .Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = 15
                End With
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = 15
                End With
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = 15
                End With
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = 15
                End With
                With .Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = 15
                End With
            End With
        End If
    Next
    Dim r2 As Range
    Set r2 = Range(Cells(2, 3), Cells(26, 2 + r.Columns.Count))

    Dim m As Range
    Dim MaxVal As Integer
    Dim c2 As Range
    For Each c In r2.Rows
        MaxVal = Application.WorksheetFunction.Max(c)
        For Each c2 In c.Cells
            If c2.Value = MaxVal Then
                With c2
                    .Font.Bold = True
                    With .Interior
                        .ColorIndex = 34
                        .Pattern = xlSolid
                    End With
                End With
            End If

        Next


    Next

    Application.Calculation = xlAutomatic

End Sub


Sub GetPlayerLevels(user As String, outputstart As Range)


    Dim activews As Worksheet
    Dim ws As Worksheet
    Set activews = ActiveSheet
    Set ws = Sheets.Add
    activews.Activate

    On Error Resume Next
    Err.Clear

    Dim urlstr As String
    urlstr = "URL;http://hiscore.runescape.com/index_lite.ws?player=" & user
    ws.Columns("A:A").NumberFormat = "@"

    With ws.QueryTables.Add(Connection:= _
       urlstr, _
          Destination:=ws.Range("a1"))
       .BackgroundQuery = True
       .TablesOnlyFromHTML = True
       .Refresh BackgroundQuery:=False
       .SaveData = True
    End With
    With ws.Columns("A:A")
        .TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    End With


    If Err.Number = 0 Then
        Range(outputstart, outputstart.Offset(24, 0)).Value = ws.Range("C2:C26").Value
    ElseIf Err.Number = 1004 Then
        Range(outputstart, outputstart.Offset(24, 0)).Value = -1
    End If


    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True



End Sub

Sub cleanup()
    With Range("C2:G26")
        .Clear
    End With
    Application.Calculation = xlAutomatic
End Sub