This takes way too long. How can I make it faster?

[coreyalderin]

I have some VBA code that is used to run 1,000s of iterations and it is taking along tim to run (about 1.5 hours). The code that I think is taking the longest time is below. Is there a better way to do this?

Range("start").Offset(loop1, last).Value = Cproduct
Set fillrange = Range(Range("start").Offset(loop1, last), _
Range("start").Offset(loop1, month1))
Set SourceRange = Range("start").Offset(loop1, last)

A little more information:
What I am trying to do is paste a value across a certain number of colums, in one row.
Then repeat that for many iterations, in the next rows.

 

[Jerry Sullivan]

The actual statements that you posted are probably not the bottleneck, the problem is more likely the high number of iterations.

Most copy/paste operations can be accomplished without looping.
If you paste your entire code, we can have a look and see if the looping can be reduced or eliminated.

 

[coreyalderin]

Here is everything. Thanks for taking a look. Let me know if there are any questions.

Range("data").ClearContents
Range("ProdsTaken2").ClearContents
sims = Range("Sims").Value
Cproduct = Range("FirstProduct").Value
PatType = Range("NewCurrent").Value

track = 0
track2 = 0
sims2 = Range("sims2").Value
Sheets("Output").Select
Range("A44").Select
loop1 = 0
Do While loop1 < sims
month1 = 0
NumbFailures = Range("NumbFailures").Value

If PatType = "CURRENT" Then

ProdsTaken = Range("ProdsTaken").Value - 1
prods = 0
Do While prods < ProdsTaken
random = Range("vbaRand").Value

x = 0
Do While x < 21
If random < Range("start2").Offset(x + 1, 3).Value Then
Range("start2").Offset(x + 1, 0).Value = "X"
x = 100
End If
x = x + 1
Loop

prods = prods + 1
Loop

End If


NP = 0
last = 0 + track2
Do While Range("Sum").Value < Range("TotalProds").Value

track2 = Application.WorksheetFunction.RoundDown(track / sims2, 0)

If Range("Sum").Value = NumbFailures And NP = 0 Then
Cproduct = Range("NPName").Value
months = Range("months2").Value
NP = 1
Else
months = Range("Months").Value
Cproduct = Range("CurrentProduct").Value
NP = 0
End If

month1 = month1 + months + track2

If month1 > 251 Then month1 = 251
If last > 250 Then last = 250

Range("start").Offset(loop1, last).Value = Cproduct
Set fillrange = Range(Range("start").Offset(loop1, last), Range("start").Offset(loop1, month1))
Set SourceRange = Range("start").Offset(loop1, last)
SourceRange.AutoFill Destination:=fillrange


If NP = 0 Then Range("start2").Offset(Cproduct, 0).Value = "X"

last = last + months

Loop
Range("ProdsTaken2").ClearContents

track = track + 1
loop1 = loop1 + 1
Loop


End Sub

 

[Jerry Sullivan]

Hi Corey,

There is a lot of looping activity going on there and I'm confident that the code can be made simpler and faster.

You are using a large number of named ranges, which is okay, except it makes it difficult to follow what the relationships are between the ranges without knowing the addresses.

Rather than going back and forth with questions on this thread, if I may review your workbook that will make it much easier.

You can either upload to a file sharing site and post a link, or send the file to my email address, which I'll send you through a PM.