Speeding up a macro

[ldowling]

Good morning All,
I am not in any way good at writing a new macro but i am "okay" at manipulating several macros to do what i want, i understand the simple side of macros but after frankensteining a macro together it seems to run horribly slow with certain changes to the code ...... surprise .... surprise .....

 Set rngSearch = ws.Columns(1).Find(What:=strWhat, LookIn:=xlValues)

with this line of code i use the

LookIn:=xlValues

and it does what i want but the problem is its very very slow and when i use

LookIn:=xlFormulas

its fast but it looks in a formula which i obviously don't want ... i want to find the value created by that formula.

My question to you great people is how can i make this faster ?

i cant share the workbook but i can provide the full macro if needed.

Thank you in advance people

 

[JackDanIce]

Re: Macro Help - Speeding up a macro

Welcome to the board.

If you're looking to match against a cell value and you're using xlValues which is faster than xlFormulas, what is your actual question? It seems you have your answer don't you?

Helpful suggestion, try to keep your post precise and succinct, easier to suggest answer.

Specifically:
What is the name of the sheet?
What is the formula in the cell?
What is the full code?

 

[ldowling]

Re: Macro Help - Speeding up a macro

Hello Jack,
sorry for that i will get straight to the point next time..

Basically when i use xlValues the code is painfully slow because i guess its working out the formula for every line and when i use xlFormulas the macro doesn't see the value of that formula.

 

[JackDanIce]

Re: Macro Help - Speeding up a macro

What is the formula?
What is the full code?

 

[ldowling]

Re: Macro Help - Speeding up a macro

Part of code in discussion

Set rngSearch = ws.Columns(1).Find(What:=strWhat, LookIn:=xlValues)

Full Code

Private Sub CommandButton2_Click()

      Dim x As Integer
      Application.ScreenUpdating = False
NumRows = ActiveSheet.Range("L4").Value
Range("A28").Select
For x = 1 To NumRows


On Error Resume Next


Dim ws As Worksheet
Dim strWhat As String
Dim rngSearch As Range
Dim rngFound As String
Dim i As Integer
Dim ValueToSearch As String


ValueToSearch = ""
MySheet = ""
strWhat = ""
rngSearch = ""
rngFound = ""


ValueToSearch = ActiveCell.Text
MySheet = ActiveSheet.Name
strWhat = ValueToSearch




For Each ws In Worksheets
        Set rngSearch = ws.Columns(1).Find(What:=strWhat, LookIn:=xlValues)
    If Not rngSearch Is Nothing Then
        i = i + 1
        If i = 1 Then
            rngFound = rngSearch.Worksheet.Name
        Else
            rngFound = rngFound & ", " & rngSearch.Worksheet.Name
            
        End If
    End If
Next ws


If rngFound = MySheet Then
MsgBox "Nothing Found"                           'Debug Purpose
Else
MsgBox "'" & strWhat & "' found on the following worksheet(s): " & rngFound & "."       'Debug Purpose
ActiveCell.Offset(0, 22).Clear
End If


      ActiveCell.Offset(1, 0).Select
      Next
      Application.ScreenUpdating = True


End Sub

 

[ldowling]

Re: Macro Help - Speeding up a macro

Formula the macro will look in

CONCATENATE(O1,D1,C1)

 

[JackDanIce]

Re: Macro Help - Speeding up a macro

Stepping away for lunch, will post suggestion when back unless anyone else does in meantime.

Few suggestions, avoid ".Select" or ".Activate" (you can find why searching online, countless explanations)
Limit searching column A to just cells with values - i.e. find out how to determine the last used row in a column. If a column contains >1m rows, searching through less than the entire column helps run faster
If L4 contains value 10, you're using a nested loop to search 1 to 10 times, for all worksheets a single value of strWhat (= ValueToSearch which is in a fixed cell A28). Why search for a value 10times when the value isn't changing?

May be easier if you explain with examples, what is in cell L4, what is in cell A28, what (succiently) are you trying to make the macro do in plain English?

 

[ldowling]

Re: Macro Help - Speeding up a macro

L4 contains "=SUMPRODUCT(--(LEN(A28:A5000)>0))" which works out how many cells contain vales in between A28:A5000, this is because working it out in the VBA counts Formulas too. This number is used by the Loop to count the amount of cells it needs to drop down.

A28 is where the first value i need to search is (Tables are above this line)

Macro Explanation

The macro is getting a value from the cell (starting at the active sheets A28), its then searching every worksheet in the workbook in column A for duplicates.

When a duplicate is found it will clear the contents of 22 cells to the right of the active cell. if nothing is found it will just drop to the next cell.

 

[JackDanIce]

Re: Macro Help - Speeding up a macro

I've tried to re-create your workbook based on information provided or inferred.

Workbook
3 sheets: Main, Sheet1, Sheet2

Main contains values "Apple", "Bear", "Cat", "Dog" in cells A28:A31. Cells W28:W31 contains "x" in all
Sheet1 contains "Apple", "Bear", "Dog" in cells A1:A3
Sheet2 contains "Apple", "Dog" in cells A1:A2

The macro below creates a summary sheet called "Macro_Results" which lists items not found or if found, what sheet in.

It runs without error and returns expected results on my re-creation of your workbook, however, test on a copy of your workbook.

Private Sub CommandButton2_Click()
        
    Dim arr()   As Variant
    Dim temp    As Variant
    Dim dic     As Object
    Dim tWks    As Worksheet
    
    Dim w       As Long
    Dim x       As Long
    Dim LR      As Long
    
    Dim msg     As String
    Const delim As String = "|"
    
    Set tWks = ActiveSheet
    Set dic = CreateObject("Scripting.Dictionary")
    
    Application.ScreenUpdating = False

    For w = 1 To Worksheets.Count
        With Sheets(w)
            If .Name <> tWks.Name Then
                LR = .Cells(.Rows.Count, 1).End(xlUp).Row
                arr = .Cells(1, 1).Resize(LR, 1).Value
            
                For x = LBound(arr, 1) To UBound(arr, 1)
                    If dic.exists(arr(x, 1)) Then
                        dic(arr(x, 1)) = dic(arr(x, 1)) & delim & .Name
                    Else
                        dic(arr(x, 1)) = .Name
                    End If
                Next x
                Erase arr
            End If
        End With
    Next w
    
    With tWks
        LR = Application.Max(28, .Cells(.Rows.Count, 1).End(xlUp).Row)
        arr = .Cells(28, 1).Resize(LR - 27, 2).Value
        For x = LBound(arr, 1) To UBound(arr, 1)
            If dic.exists(arr(x, 1)) Then
                temp = dic(arr(x, 1))
                arr(x, 1) = Replace("'@1' found on following sheet(s): @2", "@1", arr(x, 1))
                arr(x, 1) = Replace(arr(x, 1), "@2", temp)
                .Cells(x + 27, 23).ClearContents
            Else
                arr(x, 1) = arr(x, 1) & " not found in workbook"
            End If
        Next x
    End With
    
    Worksheets.Add before:=tWks
    With ActiveSheet
        .Name = "Macro_Results"
        .Cells(1, 1).Resize(UBound(arr, 1)).Value = arr
        .Cells(1, 1).EntireColumn.AutoFit
    End With
            
    Application.ScreenUpdating = True
    
    Erase arr
    Set tWks = Nothing
    
End Sub

After running the code, only W30 contains an "x" on sheet Main

 

[ldowling]

Re: Macro Help - Speeding up a macro

Good afternoon Jack, Thank you for your reply, after trying your code it just crashes my worksheet. probably because it needs to check alot of worksheets & data.

Could you just help me with speeding up my macro or somehow working around the problem.

Problem is: When i use the below line of code, it takes about 12 seconds per row, when i use "LookIn:=xlFormulas" it is very quick but it looks in formulas of the other sheets and dosent look at the value created by that formula.

[COLOR=#333333]rngSearch = ws.Columns(1).Find(What:=strWhat, LookIn:=xlValues)[/COLOR]

using "xlValues" works but it just takes sooooo longg.

Just wondering if you have any solution to make this quicker or you have a solution to the problem?

Thank you