Macro Speed Up - Help

[SamT]

you are referring to Ranges and using the .End function too many times

Try this:[vba]Sub AddSecsMulti()
Dim NewSecsRng As Range
Dim StrtTimes As Range
Dim StrtSec As Long
Dim SecCnt As Long
Dim TimeCel As Range
Dim i As Long
Dim c As Long
Dim NextRow As Long
Dim Ndx As String

Application.ScreenUpdating = False
Range("G2:I" & Range("G" & Rows.Count).End(xlUp).Row).Clear
Set StrtTimes = Range("A2:" & Cells(Rows.Count, 1).End(xlUp).Address)
NextRow = 2

For Each TimeCel In StrtTimes
Ndx = TimeCel.Offset(0, 2).Text
StrtSec = TimeCel.Value
SecCnt = CLng(Format(TimeCel.Offset(0, 1).Value - StrtSec, "s"))

With Range("G" & NextRow & ":I" & NextRow + SecsCnt - 1)
For i = 1 To SecCnt
.Cells(i, 1) = DateAdd("s", i - 1, StrtSec)
.Cells(i, 2) = DateAdd("s", i, StrSec)
.Cells(i, 3) = Ndx
Next i
End With

NextRow = NextRow + SecsCnt
Next TimeCel

Range("G2:H" & Range("G" & Rows.Count).End(xlUp).Row).NumberFormat = "dd.mm.yyyy hh:mm:ss"
Application.ScreenUpdating = True
End Sub
[/vba]