Solved: Slow Down On Running Code

[sooty8]

Hi All

Originally the code below in Column "I" was for just 500 rows it has now been extended to 5,000 - for 500 rows it ran and did the necessary in about 10 Seconds after expanding the rows - ran it yesterday and it took approx 11 minutes - did the job perfectly no problems - is it just the expansion of rows causing the time taken? if so we accept it as OK. Or can you guys find away round this small time problem?

Regards

Sooty8


[VBA]
Private shIndex As Long

Private Sub CommandButton1_Click()
Dim i
Application.ScreenUpdating = False
For i = 2 To Cells(Rows.Count, "I").End(xlUp).Row
tb1a = Cells(i, "I")
Find_Click
enterdata_Click
Next
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
Call Module11.ClearText
End Sub
Private Sub enterdata_Click()
Application.ScreenUpdating = False
shIndex = 1
SearchForValue
Application.ScreenUpdating = True
End Sub
Private Sub SearchForValue()
Application.ScreenUpdating = False
Dim rngFound As Range
Dim rngToSearch As Range
Dim FindWhat As String
Dim Matches As Boolean
Dim j As Long
Set rngFound = Nothing
FindWhat = tb1a.Text
For j = 2 To Sheets.Count
Set rngToSearch = Worksheets(j).Columns("A")
Set rngFound = rngToSearch.Find(What:=Trim(FindWhat), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
tb1a.SetFocus
If Not (rngFound Is Nothing) Then
With Me
.Tb2.Text = rngFound.Offset(0, 2).Value
.Tb3.Text = rngFound.Offset(0, 1).Value
.Tb4.Text = rngFound.Offset(0, 4).Value
For i = 5 To 24
Set Ctrl = Controls("Tb" & i)
If Len(Trim(Ctrl.Text)) <> 0 Then _
rngFound.Offset(0, i) = Ctrl.Text
Next
End With
Else
shIndex = shIndex + 1
End If
Next
Application.ScreenUpdating = True
End Sub

Private Sub Tb1A_Change()
tb1a.Value = UCase(tb1a.Value)
End Sub
Private Sub Find_Click()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim vecRows As Variant
Dim iRow As Long
Dim i As Long
Set ws = Worksheets("CSV")
With Me
vecRows = Application.Evaluate("IF(TRIM(I2:I5000)=""" & Trim(tb1a) & """,ROW(I2:I5000))")
If .tb1a.Text <> "" Then
For i = LBound(vecRows) To UBound(vecRows)
If vecRows(i, 1) Then
iRow = vecRows(i, 1)
Select Case ws.Cells(iRow, "H").Value2
Case 4161: .Tb5.Text = ws.Cells(iRow, 10): .Tb6.Text = ws.Cells(iRow, 11)
Case 5092: .Tb7.Text = ws.Cells(iRow, 10): .Tb8.Text = ws.Cells(iRow, 11)
Case 5064: .Tb9.Text = ws.Cells(iRow, 10): .Tb10.Text = ws.Cells(iRow, 11)
Case 4180: .Tb11.Text = ws.Cells(iRow, 10): .Tb12.Text = ws.Cells(iRow, 11)
Case 4048: .Tb13.Text = ws.Cells(iRow, 10): .TB14.Text = ws.Cells(iRow, 11)
Case 4064: .Tb15.Text = ws.Cells(iRow, 10): .Tb16.Text = ws.Cells(iRow, 11)
Case 5029: .Tb17.Text = ws.Cells(iRow, 10): .Tb18.Text = ws.Cells(iRow, 11)
Case 4087: .Tb19.Text = ws.Cells(iRow, 10): .Tb20.Text = ws.Cells(iRow, 11)
Case 5042: .Tb21.Text = ws.Cells(iRow, 10): .Tb22.Text = ws.Cells(iRow, 11)
Case 4199: .Tb23.Text = ws.Cells(iRow, 10): .Tb24.Text = ws.Cells(iRow, 11)

End Select
End If
Next i
End If
End With
Application.ScreenUpdating = True
End Sub



[/VBA]

[Bob Phillips]

Can you give a short, English language description, of what happens here?

[Shred Dude]

For starters, I'd try eliminating the

[VBA]Application.screenupdating=true[/VBA]

statements at the end of the three subroutines:

Find_Click
enterdata_Click
SearchForValue


Let the whole thing run from the main sub, CommandButton1_Click() , and don't turn screen updating back on until its done.

If turning off calculation would be acceptable to the process, you might try setting calculation to manual and then reactivating at the end.

The nested loops you have will clearly take longer to execute with more source data. Would need to see the data to get a better idea of what you're doing to offer further suggestions.

[sooty8]

Hi Guys

Thanks for the reply - OK what I'm going to do - is a cut down example with the UserForm and a couple of sheets there are 20 in the workbook it will probably take me a couple of hours if I don't finish it tonight will post tomorrow am. Uk time now 19:30Hrs.

Regards

Sooty8

[sooty8]

Hi Guys

Just about made the AM time slot 3 Hours late this morning cause of the weather - attached a very shortened version of the UserForm & how it runs on a couple of sheets - hope you can help.

Regards

Sooty 8.

[Bob Phillips]

See if this is any better

[vba]


Private Sub Find_Click()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim cell As Range
Dim firstAddress As String
Dim iRow As Long
Dim i As Long

Set ws = Worksheets("Sheet1")

With Me

If .tb1a.Text <> "" Then

Set cell = ws.Columns("I").Find(.tb1a.Text)
If Not cell Is Nothing Then

firstAddress = cell.Address
Do

Select Case cell.Offset(0, -1).Value2 'ws.Cells(iRow, "H").Value2

Case 4161: .Tb5.Text = ws.Cells(cell.Row, 10): .Tb6.Text = ws.Cells(cell.Row, 11)
Case 5092: .Tb7.Text = ws.Cells(cell.Row, 10): .Tb8.Text = ws.Cells(cell.Row, 11)
Case 5064: .Tb9.Text = ws.Cells(cell.Row, 10): .Tb10.Text = ws.Cells(cell.Row, 11)
Case 4180: .Tb11.Text = ws.Cells(cell.Row, 10): .Tb12.Text = ws.Cells(cell.Row, 11)
Case 4048: .Tb13.Text = ws.Cells(cell.Row, 10): .TB14.Text = ws.Cells(cell.Row, 11)
Case 4064: .Tb15.Text = ws.Cells(cell.Row, 10): .Tb16.Text = ws.Cells(cell.Row, 11)
Case 5029: .Tb17.Text = ws.Cells(cell.Row, 10): .Tb18.Text = ws.Cells(cell.Row, 11)
Case 4087: .Tb19.Text = ws.Cells(cell.Row, 10): .Tb20.Text = ws.Cells(cell.Row, 11)
Case 5042: .Tb21.Text = ws.Cells(cell.Row, 10): .Tb22.Text = ws.Cells(cell.Row, 11)
Case 4199: .Tb23.Text = ws.Cells(cell.Row, 10): .Tb24.Text = ws.Cells(cell.Row, 11)

End Select

Set cell = ws.Columns("I").FindNext(cell)
Loop While Not cell Is Nothing And cell.Address <> firstAddress
End If
End If
End With
Application.ScreenUpdating = True
End Sub
[/vba]

[sooty8]

Hi Xld

Many thanks - how does 4Minutes - 41 Seconds compare with 11 Minutes? after your revamp - Once again the top man gets it right.

Regards

Sooty 8

All the best for 2011

[Bob Phillips]

Well, it is an improvement, but it is still not good.

In my test it didn't take anything like 4:41, so I presume that the real data is much larger. Also I didn't really know what to do, so I justr entered 123 in the first box and hit Enter. What do you do in reality?

[sooty8]

Hi Xld

I apologise should have mentioned below in previous post.

Ran the full data which consisted of 3,820 rows that meant that the data was entered correctly into 7,640 separate cells - does that justify it taking 4Mins 41Secs? - I just thought it was brilliant. I'm sure you will let me know if it can have Go Faster Stripes attached!!

Regards

Sooty8.

[Bob Phillips]

That still seems too long to me.

I still don't get what is happening. The ID No is a dropdown, but there is nothing in there. Should it be populated with all available IDs? Using your testdesk, if I entered 123 in the dropdown, and it changed it to ID2362 and populated 2 codes.

If you summarise what happens, I am sure we can reduce it to seconds (I had a job recently that was looking in many workbooks, and it took hours. In one loop, I reduced the loop from 6 minutes plus to less than 1 second, there are always ways )

[sooty8]

Hi Xld

Just had a look at the test one why the drop down is not showing the ID numbers I just don't know - on the original mentioned in the post above 3,820 rows the Drop Down is displaying all 382 ID numbers - I get to to 3,820 rows because there are 10 Sites each Site has a different Code Number (eg -4161) - What I normally do is click on the 1st ID number in the drop down when the program has run its course it displays all the data in the Userform for the last ID number on the Drop Down - I then know its all in place. I receive all the data in an email as a CSV file. I run the Text 2 Columns and everything drops onto Sheet1 - open UserForm select 1st drop down Id and off it runs - does that explain it better? Doing my best!!!

Regards

Sooty 8.

[Bob Phillips]

Not complaining mate, just don't like the idea of code that takes 4mins+ to process a measly 7,000 rows.

As I said, when I input a fictitious number, it populated the last ID. When I input the first real ID, it still populated the last ID, with all of its code values.

So does that mean that you need to populate the userform with details of the very last ID? If so, we can make that instantaneous.

[sooty8]

Hi Xld

So long as it puts all the other data in the correct cells for each ID number - now got the ID numbers in the drop down sent previously - attached it - I like the description measly - 7,000 odd cells to me is absolutely massive - go on mate show us how its down in a second.

Will a bottle of Bells be OK

Regards

Sooty8.

[Bob Phillips]

How about this?

[sooty8]

Hi Xld

Its Karno's here this morning - had a quick look & downloaded the new file then had to help shifting / shoving vehicles out of the way - anyway what can I say less than a second that's amazing "Is it possible to work on the big one with the 7,000 cells etc and if so what code / modules would I use?

BTW the Bells is now Jura Finest Malt

Regards

Sooty8

[Bob Phillips]

Its Karno's here this morning - had a quick look & downloaded the new file then had to help shifting / shoving vehicles out of the way

Really, it is (relatively) warm down here, hardly any snow to speak of.

anyway what can I say less than a second that's amazing "Is it possible to work on the big one with the 7,000 cells etc and if so what code / modules would I use?

Not sure mate, as I am not clear how (well) this example relates to the real thing.

BTW the Bells is now Jura Finest Malt

So what do I need to do to upgrade it to a Lagavulin Distillers Edition, or Caol Ila OB 18yo, or Highland Park OB 18yo, or even Laphroaig OB 15yo?

[sooty8]

Hi Xld

Just been on the Whisky Distillers Single Malt Site looks like you have already named the best of the lot - as far as I'm concerned you could have the lot listed above - but I daren't send the file to much data and if you viewed the whole shebang that it is loaded into and the code, if you are not a screaming banshee now - you would be when viewing this lot and trying to sort it out. Thank you for all your help and a happy Christmas & Prosperous New Year.

Regards

Sooty8.

[Bob Phillips]

Just been on the Whisky Distillers Single Malt Site looks like you have already named the best of the lot

Oh, I don't know about that. There are so many, Ardberg, Talisker, Macallan, Bruichladdich, Springbank, and many, many more. I have even heard good things about St George, the first English whisky for many years, although I haven't found a bottle myself, so I cannot comment.

Thank you for all your help and a happy Christmas & Prosperous New Year.

And best wishes to you as well. Keep the interesting projects coming.

[sooty8]

Hi Xld

Walking the cherry hog earlier and got to thinking about the speed the code runs ( as you do) just a thought there are 38 sheets in the workbook of which 5 are hidden of the rest only 20 are relevant to the above - what if they were all named separately within the code e.g "joe,fred,john"would it run faster then??

Regards

Sooty8.

[Bob Phillips]

It should do, avoiding unnecessary loops, even quick loops, should improve it, but not by huge amounts.