Help speed up my for loop

[edwardtong694]

Hi Guys,

I have a for loop which is as follows.

 'Do something with all the data between C27 and c37
    For Each rng In Range("C27:C37")
    'if there is data in the cell then
    If Not IsEmpty(rng) Then
        'List the DDI and then plus one until all numbers are complete.
        For x = 0 To rng.Offset(0, 2).Value - rng.Value
            'Print the information into the lists field.
            Sheets("Lists").Cells(Rows.Count, "K").End(xlUp).Offset(1, 0) = rng.Value + x
        Next X

The code will loop through numbers in Cell C27 and C37 and list out all the values between values in cell c27 and d27 and so on and then copy's them to cell K. The code works as expected but it is slower than i think it should be.

I have stepped through the code and it looks as if once it has completed it starts again and again when it doesn't need to. I want the formula to ignore blank cells.

I was wondering if anyone could take a look and see if they can see anything obvious i am missing.

Thanks

Ed

 

[Norie]

Ed

That code doesn't look at column C and D it looks at C and E.

Try this, change the offset if it is meant to look at C & D instead of C & E.

Dim rng As Range
Dim X As Long

    For Each rng In Range("C27:C37")

        'if there is data in the cell then
        If Not IsEmpty(rng) Then
            X = rng.Offset(, 2).Value - rng.Value + 1

            With Sheets("Lists").Cells(Rows.Count, "K").End(xlUp).Offset(1, 0)
                .Value = rng.Value
                .Resize(X).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1
            End With
        End If


    Next rng