asked on
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
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
VBA
Last Comment
Rgonzo1971
What about querying your workbook ?
Your workbook will need to be up to date for this to work as expected, so you might need to save it 1st.
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
Your workbook will need to be up to date for this to work as expected, so you might need to save it 1st.
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
ASKER
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
ASKER CERTIFIED SOLUTION
THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
pls try
Open in new window
Regards