Speed up VBA code

Hi,

I am using... the following code to scan 52 sheets completely for the number 85099055 and if it finds that number to sum up the 7 values to its right of where it was found on each sheet.

Works great, however once the sheet contains about 20k plus of other values it slows down to a grind, is there a way to speed this up dramatically...  If it helps the Range can be reduced to just B8:B60, G8:G60 AND V8:V60 and the number will not be on every sheet and if it is will just appear once per sheet.  Thanks

Number = 85099055
Total=0
      For Idx = 1 To 52
            With Sheets(Idx).Cells
                Set c = .Find(Number, .Cells(.Rows.Count, .Columns.Count), lookat:=xlWhole)
                If Not c Is Nothing Then Total = Total + WorksheetFunction.Sum(c.Offset(0, 2).Resize(1, 7))
            End With
        Next

Open in new window

MirageSFAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
Hi,


pls try
Number = 85099055
Total=0
      For Idx = 1 To 52
            With Sheets(Idx).UsedRange.Cells
                Set c = .Find(Number, .Cells(.Rows.Count, .Columns.Count), lookat:=xlWhole)
                If Not c Is Nothing Then Total = Total + WorksheetFunction.Sum(c.Offset(0, 2).Resize(1, 7))
            End With
        Next

Open in new window

Regards
0
Fabrice LambertFabrice LambertCommented:
What about querying your workbook ?
Dim oConn As Object
Dim oRs As Object
Dim strConnect As String
Dim strSQL As String
Dim ws As Excel.Worksheet

strConnect = vbNullString
strConnect = strConnect & "Provider=Microsoft.ACE.OLEDB.12.0;"
strConnect = strConnect & "Data Source="ThisWorkbook.FullName & ";"
strConnect = strConnect & "Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"

Set oConn = CreateObject("ADODB.Connection")

For Each ws In ThisWorkbook.Worksheets
	strSQL = vbNullString
	    '// F1 = column A
		'// F2 = column B ect .. and so on
	strSQL = strSQL & "SELECT F2, F3, F4, F5, F6, F7, F8 ......" & vbcrlf
	strSQL = strSQL & "FROM [" & ws.Name & "$]" & vbcrlf
	strSQL = strSQL & "WHERE F2 = ""85099055""" & vbcrlf    '// column B
	strSQL = strSQL & "   OR F7 = ""85099055""" & vbcrlf    '// column G
	strSQL = strSQL & "   OR F22 = ""85099055"";"   '// column V
	Set oRs = CreateObject("ADODB.Recordset")
	oRs.Open strSQL, oConn
	If Not(oRs.BOF and oRs.EOF) Then
	    '// recordset isn't empty, do something with datas
	End If
	oRs.Close
	Set Ors = Nothing
Next
oConn.Close
Set oConn = Nothing

Open in new window

Notes:
Your workbook will need to be up to date for this to work as expected, so you might need to save it 1st.
0
Rgonzo1971Commented:
then try
Number = 85099055
Total=0
      For Idx = 1 To 52
            With Sheets(Idx).Range("B8:B60,G8:G60,V8:V60")
                Set c = .Find(Number, .Cells(.Rows.Count, .Columns.Count), lookat:=xlWhole)
                If Not c Is Nothing Then Total = Total + WorksheetFunction.Sum(c.Offset(0, 2).Resize(1, 7))
            End With
        Next

Open in new window

EDIT Corrected code
0
MirageSFAuthor Commented:
Rgonzo would that be faster than your other code?  I see u uses usedrange in first one anyway to combine to make it even faster as not all those ranges have numbers, also once it finds number it can leave that particular sheet and move on rather than checking entire ranges regardless cheers
0
Rgonzo1971Commented:
if your number is a value then try
Number = 85099055
Total=0
      For Idx = 1 To 52
            With Sheets(Idx).Range("B8:B60,G8:G60,V8:V60").SpecialCells(xlCellTypeConstants, 1) ' replace xlCellTypeConstants with xlCellTypeFormulas if formula
                Set c = .Find(Number, .Cells(.Rows.Count, .Columns.Count), lookat:=xlWhole) ' search for the first element with Number 
                If Not c Is Nothing Then Total = Total + WorksheetFunction.Sum(c.Offset(0, 2).Resize(1, 7))
            End With
        Next

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.