Speed up Code

[Bomino]

Hi experts,
I would like someone to please look at the following code and make it execute a little faster. Thank you.

Sub Feeder()
    Dim SourceRange As Range, DestRange As Range
    Dim DestSheet As Worksheet, Lr As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'fill in the Source Sheet and range
    Set SourceRange = Main.Range("xferdata")

    'Fill in the destination sheet and call the LastRow
    'function to find the last row
    Set DestSheet = DATA
    Lr = DATA.Cells(Rows.Count, 1).End(xlUp).Row

    'With the information from the LastRow function we can create a
    'destination cell
    Set DestRange = DestSheet.Range("B" & Lr + 1)

    'We make DestRange the same size as SourceRange and use the Value
    'property to give DestRange the same values
    With SourceRange
        Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count)
    End With
    DestRange.Value = SourceRange.Value
   
    Dim lastRow As Long, counter As Long
    Dim cell As Range
    Dim ws As Worksheet
  Set ws = ThisWorkbook.Worksheets("Data")

    lastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
    counter = 1
    For Each cell In ws.Range("A6:A" & lastRow)
        cell.Value = counter
        counter = counter + 1
    Next cell

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

 

[Marc L]

Hi ! Try this :​

Sub Demo1()
    With Application
           .Calculation = xlCalculationManual
          .EnableEvents = False
        .ScreenUpdating = False
    With Main.[xferdata]
         DATA.Cells(Rows.Count, 1).End(xlUp)(2, 2).Resize(.Rows.Count, .Columns.Count).Value = .Value
    End With
    With DATA.Range("A6", DATA.Cells(Rows.Count, 2).End(xlUp)(1, 0))
        .Value = Evaluate("ROW(1:" & .Rows.Count & ")")
    End With
           .Calculation = xlCalculationAutomatic
          .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Marc L]

And this :​

Sub Demo2()
                      V = Main.[xferdata].Value
    With Application
           .Calculation = xlCalculationManual
          .EnableEvents = False
        .ScreenUpdating = False
    With DATA.Cells(Rows.Count, 1).End(xlUp)(2).Resize(UBound(V))
        .Offset(, 1).Resize(, UBound(V, 2)).Value = V
        .Value = Evaluate("ROW(" & .Row - 5 & ":" & .Row + UBound(V) - 6 & ")")
    End With
           .Calculation = xlCalculationAutomatic
          .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

You may Like it !
​

 

[Bomino]

Marc L,
Just one word: Amazing.
Both codes are blazing-fast.
Thank you as always

 

[Marc L]

These codes respect two VBA main rules : TEBV and TBTO !

• Think Excel Before VBA !

Here using ROW worksheet function faster
than a VBA loop very time consuming …

First question before writing any codeline :
What can be directly achieved within Excel ?
(formulas, inner features like filters, advanced filters, sort, find, …)

• Think, But Think Object !

As declaring an Object variable to use it in a With statement is useless
(for example your SourceRange variable) and wastes time and memory !
Better is to directly use the original object
(for example Main.Range("xferdata") …) in a With statement.

Another example if a worksheet is in the code workbook,
it is useless to declare an Object variable for this worksheet
(for example your codeline Set ws = ThisWorkbook.Worksheets("Data")
or worse your codeline Set DestSheet = DATA !
So you create two Object variables for same worksheet !?)
because already exists a worksheet CodeName variable !
(Aka DATA which is a reference to same worksheet of codelines above …)

The same for a last row variable, it may be better
to use a range in a With statement.

So to revisit your code I've just removed all the useless …
​

 

[Bomino]

Thank you Marc L.