CODEWITHSUNDEEP
vbaexcel
Meesha
Meesha

Reputation: 821

Generate a straight sequence of numbers depending on the lastrow

lrow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
For p = 1 To lrow
    period(p) = p
Next p
With ws2
    lrow2 = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A1").Offset(lrow2, 1).Resize(lrow).Value = Application.Transpose(period)
    ws1.Range(ws1.Cells(5, 1), ws1.Cells(lrow, 1)).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 2)
End With

As you see, I am trying to copy data columns from one sheet to another and it works well. But if notice I am generating a sequence in p from 1 to lastrow , which looks very dumb to me because I am using a loop and I am sure there is another way to generate it and copy it in to another sheet. How can I fasten this as removing the application.transpose(period) line from the code makes it run in half the time. I am requesting for an faster method if anyone can advice on. Thanks.

E.g.

  Sheet1                           Sheet2
  John                          1  John
  Jim                           2  Jim
  Jack                          3  Jack

I am generating Sheet2 from Sheet1 and the numbers and names are in different columns. I can use copy like I have in my code for names, but I need to generate the numbers myself.

Upvotes: 2

Views: 205

Answers (3)

Excel Hero
Excel Hero

Reputation: 14764

This will output both the columns you are looking for; numbers in one column and the names in the next:

Public Sub YourSolution()
    Dim v
    v = Sheet1.[CHOOSE({1,2},ROW(OFFSET(A1,,,COUNTA(A:A))),A1:INDEX(A:A,COUNTA(A:A)))]
    Sheet2.[b3:c3].Resize(UBound(v)) = v
End Sub

It should be quick enough that you need not bother turning off screen updating or setting calculation to manual.

Upvotes: 2

paul bica
paul bica

Reputation: 10715

I was curious about this so I measured 4 options:

Max itms:    65,000
  Transpose: 0.0586 sec
  Formula:   0.0938 sec
  Fill down: 0.0273 sec <<<
  2D Array:  0.0547 sec

Max itms:    1,000,000
  Formula:   0.4688 sec
  Fill down: 0.2305 sec <<<
  2D Array:  0.6992 sec

.

Test code:

Public Sub idSequence()
    Const MAXR As Long = 1000000
    Const CRx2 As String = " sec" & vbCrLf  ' & vbCrLf
    Const NFRM As String = "#,##0.0000"
    Dim arr As Variant, i As Long, msg As String, t As Double

    If MAXR <= 65000 Then    'Upper Limit: 65,000
        t = Timer
        ReDim arr(1 To MAXR)
        For i = 1 To MAXR
            arr(i) = i
        Next
        Range("A1:A" & MAXR).Formula = Application.Transpose(arr)
        msg = msg & "Transp: " & vbTab & Format(Timer - t, NFRM) & CRx2
    End If

    t = Timer
    Range("B1:B" & MAXR).Formula = "=Row()"
    msg = msg & "Formula:" & vbTab & Format(Timer - t, NFRM) & CRx2

    t = Timer
    Range("C1") = 1
    Range("C1:C" & MAXR).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
    msg = msg & "Fill down:" & vbTab & Format(Timer - t, NFRM) & CRx2

    t = Timer
    ReDim arr(1 To MAXR, 1 To 1)
    For i = 1 To MAXR
        arr(i, 1) = i
    Next
    Range("D1:D" & MAXR) = arr
    msg = msg & "2D Array:" & vbTab & Format(Timer - t, NFRM) & CRx2

    Debug.Print "Max itms: " & vbTab & Format(MAXR, "#,##0")
    Debug.Print msg
End Sub

Upvotes: 3

BruceWayne
BruceWayne

Reputation: 23283

So your question is how to speed this up? A first suggestion is to add the following to the beginning and end to your Macro:

At the beginning:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

then at the end:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Upvotes: 2

Related Questions