Posts by junho lee

Sub InsertRow()
    Dim OneCol As Variant
    Dim i As Long
    Dim j As Long
    OneCol = Range("A1:A" & Range("A65536").End(xlUp).Row)
    For i = UBound(OneCol, 1) To 1 Step -1
        If IsNumeric(OneCol(i, 1)) And OneCol(i, 1) = Int(OneCol(i, 1)) Then
            Rows(i + 1 & ":" & i + OneCol(i, 1)).EntireRow.Insert
            For j = 1 To OneCol(i, 1) + 1
                Range("B" & i + j - 1) = j
            Next
           Range("C" & i, Range("IV" & i).End(xlToLeft)).Resize(OneCol(i, 1) + 1).Value = Range("C" & i, Range("IV" & i).End(xlToLeft)).Value
        End If
    Next
End Sub

Sub Macro1()
'
' Macro1 Macro
'
         x = 6
         For x = 6 To 10
         With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www3.nowgoal.com/1x2/companyhistory.aspx?id=281&company=Bet 365&matchdate=2010-11-" & x _
        , Destination:=Range("$A$" & RDB_Last(1, Cells) + 1))
        .Name = "companyhistory.aspx?id=281&company=Bet 365&matchdate=2010-11-06"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = True
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        End With
         Next x
        End Sub
Function RDB_Last(choice As Integer, rng As Range)
'Ron de Bruin, 5 May 2008
' 1 = last row
' 2 = last column
' 3 = last cell
    Dim lrw As Long
    Dim lcol As Integer
    Select Case choice
    Case 1:
        On Error Resume Next
        RDB_Last = rng.Find(What:="*", _
                            after:=rng.Cells(1), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
        On Error GoTo 0
    Case 2:
        On Error Resume Next
        RDB_Last = rng.Find(What:="*", _
                            after:=rng.Cells(1), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
        On Error GoTo 0
    Case 3:
        On Error Resume Next
        lrw = rng.Find(What:="*", _
                       after:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
        On Error GoTo 0
        On Error Resume Next
        lcol = rng.Find(What:="*", _
                        after:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0
        On Error Resume Next
        RDB_Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
        If Err.Number > 0 Then
            RDB_Last = rng.Cells(1).Address(False, False)
            Err.Clear
        End If
        On Error GoTo 0
    End Select
End Function

'http://www.eggheadcafe.com/software/aspnet/33077454/worksheetfunctionmatch.aspx
' GoalSeekEPCMarginRequirement Macro
'
' Set Variables
    Dim ActiveCase As Long
    Dim EPCMargins As Range
    Dim EPCMargin As Range
    On Error Resume Next
    ActiveCase = WorksheetFunction.Match(Range("ActiveCase"), Range("Scenarios"), 0)
    If Err.Number <> 0 Then
        MsgBox "Not found"
        Err.Clear
    Else
        Set EPCMargins = Range("EPCMargins")
        Set EPCMargin = EPCMargins(1, ActiveCase)
        ' Set XIRR Value for Goalseek to Owner ATIRR Hurdle
        Range("TotalULXIRR").Value = Range("OwnerATIRRHurdle").Value
        ' Goalseek
        Range("TotalULXNPV").GoalSeek Goal:=0, ChangingCell:=EPCMargin
    End If
    On Error GoTo 0

Sub Macro1()
'first select chart
'seriescollection(1).points(4)
    With ActiveChart.SeriesCollection(1).Points(4)
        With .Border
            .Weight = xlThin
            .LineStyle = xlAutomatic
        End With
        .Shadow = False
        .InvertIfNegative = False
        With .Interior
            .ColorIndex = 6  'yellow
            .Pattern = xlSolid
        End With
    End With
'ActiveChart.SeriesCollection(2)
    With ActiveChart.SeriesCollection(2)
        With .Border
            .Weight = xlThin
            .LineStyle = xlAutomatic
        End With
        .Shadow = False
        .InvertIfNegative = False
        With .Interior
            .ColorIndex = 50  'green
            .Pattern = xlSolid
        End With
    End With
End Sub

Dim cht As Chart
    'first chart in activesheet
    Set cht = ActiveSheet.ChartObjects(1).Chart
    Dim valsrs
    Dim i As Long
    'With cht.SeriesCollection(1)
    With ActiveChart.SeriesCollection(1)
        valsrs = .Values
    End With
    For i = 1 To UBound(valsrs)
        Debug.Print valsrs(i)
    Next