Object problems with .Find() method

JimSnyder

Board Regular
Joined
Feb 28, 2011
Messages
125
First of all, I am working on a macro in Excel 2003 on a Windows XP box. I work in Excel and VBA once in a while.

This macro was written by me months ago and has worked fine running daily. The users have asked for new features and that is where I am having problems.

An error log is generated in one tracking system and exported as type ".log". My macro imports it into sheet1 of a template workbook and distributes the errors to each of the factories to review. The errors are part of a training tracking system and the latest addition is to get rid of all the previously existing errors. To do this, I placed 29,703 errors on sheet2 to compare each imported log file against.

The spreadsheet has over 50 columns, so I chose the few key columns to concatenate and placed them out beyond the 50 columns in a column of their own. The formula for cells in that column is the same on sheet1 and sheet2. It is simply "=CONCATENATE(A4,B4,AM4)".

The errors I am battling are mismatched types and Object or With variable not declared. I am off for the day, so I will respond in the morning to any additional questions.

Here are the declarations:

Code:
    ' Declare macro wide variables
    Dim currentRow As Integer, sheetIndex As Integer
    Dim rowCount As Long, lastRow As Long
    Dim pctDone As Single
    Dim Filename As String, currentCell As String
    Dim curCell As Range, curRange As Range, tarRange As Range, tarCell As Range

And here is the problem section of code:

Code:
    ' ============================== Compare errors to baseline errors ================================================
    ' Update progress bar
    ProgressBar.LabelCaption = "Comparing errors to baseline..."
    ProgressBar.FrameRibbon.Caption = "0%"
    ProgressBar.LabelRibbon.Width = 0
    DoEvents
 
    ' Copy concatenation formula into sheet1 after import
    ActiveWorkbook.Sheets(2).Activate             ' Get formula
    Range("AT1").Select
    Selection.Copy
    ActiveWorkbook.Sheets(1).Activate             ' Paste formula
    Columns("AT").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1").Select
 
    ' Get a count of rows from the old errors sheet for looping
    ActiveWorkbook.Sheets(2).Activate             ' Get formula
    Set curRange = Range([AT1].End(xlUp), [AT65536].End(xlUp))
    rowCount = curRange.Rows.Count
    Set tarCell = Cells(1, 46)
 
    ' Find each row in Sheet2 and delete from Sheet1
    For rowIndex = 1 To rowCount
 
        ' Calculate the percent done and update and ribbon
        pctDone = sheetIndex / Sheets.Count
        With ProgressBar
            .FrameRibbon.Caption = Format(pctDone, "0%")
            .LabelRibbon.Width = pctDone * .FrameRibbon.Width
        End With
 
        ActiveWorkbook.Sheets(2).Activate             ' Get current row
        currentCell = (Cells(rowIndex, "AT").Value)
        ActiveWorkbook.Sheets(1).Activate
        Set tarRange = Range([AT1].End(xlUp), [AT65536].End(xlUp))
 
        ' Search sheet1 for every occurrence of the row
        With tarRange
'            Set tarCell = .Find(What:=currentCell, After:=ActiveCell, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows).Offset(-1, 0)
'            Set tarCell = .Find(What:=currentCell, _
                                After:=Cells(1, 46), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
            Set tarCell = .Find(What:=currentCell, _
                                LookIn:=xlValues)
            If Not tarCell Is Nothing Then
                firstAddress = c.Address
                tarCell.Offset(1, 0).EntireRow.Delete
 
                ' Loop until every copy of the row is deleted
                Do
                    Set tarCell = .FindNext(tarCell)
                Loop While Not tarCell Is Nothing And tarCell.Address <> firstAddress
            End If
        End With
 
    Next rowIndex
 
    ' Hide the old errors sheet
    ActiveWorkbook.Sheets(2).Activate             ' Hide from users
    ActiveWindow.SelectedSheets.Visible = False
 
    ' Delete the concatenation column from sheet 1
    ActiveWorkbook.Sheets(1).Activate             ' Return home
    Columns("AT:AT").Select                       ' Delete the work column
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Application.Wait (Now + TimeValue("0:00:01")) ' Show completion

As the code sits, I am returning no errors, but also am finding "nothing". I can eyeball a watch and the spredsheet and verify that the data is there and matches. When I use more detailed "Find" instructions, it dies on the "Find".
 
One final comment for possibly improving speed. If the list in importLog is shorter than the list in staticErrors, it would be faster to loop through all the AT cells in importLog and .Find a match in staticErrors. I'm not inclined to rewrite the code for you. Just offering a suggestion.
 
Upvote 0

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
I had thought of that beffore starting. I may go ahead and do it anyway. First goal was to get it to work so I could get the additional requirements once users saw it.
 
Upvote 0
By using the file rows to search in the static range, I dropped run times from 24 minutes, 44 seconds to 5 minutes. The file currently has 3 more rows than the static range, so it wasn't expected. I think it came from doing away with needing to look for additional rows since I now do one row from the file at a time.

When this goes to production, most days will have nothing in the file, so this will fly.
 
Upvote 0
With ~30K rows on both the importLog and staticErrors sheets, this method should take only a second or two to complete. It reads your data into array variables. It then does all the filtering on the arrays and writes the results back to the importLog. Test it on a copy of your data.

Code:
Sub test()
    
    Dim staticErrors As Worksheet, importLog As Worksheet
    Dim vStaticErrs As Variant, vImportLog As Variant, vResults() As Variant
    Dim rngImportLog As Range
    Dim r As Long, rr As Long, c As Long
    
    ' ============================== Compare errors to baseline errors ================================================
    ' Assign variables to worksheets
    Set staticErrors = ActiveWorkbook.Sheets(2)
    Set importLog = ActiveWorkbook.Sheets(1)
    
    Application.StatusBar = "Processing..."
    
    ' Read all static errors to an array
    With staticErrors
        vStaticErrs = .Range("AT1", .Range("AT" & Rows.Count).End(xlUp)).Value
    End With
    
    ' Set importLog range variable and read data to an array
    Set rngImportLog = importLog.Range("A1:AS" & importLog.Cells.Find("*", , , , xlByRows, xlPrevious).Row)
    vImportLog = rngImportLog.Value                 ' importLog data array
    ReDim vResults(1 To UBound(vImportLog), 1 To 45) ' resize the "vResults" array the same size as the importLog data array
    
    With CreateObject("Scripting.Dictionary")       ' Dictionary object: uber-fast at IfExists type comparisons
        .CompareMode = 1                            ' Text compare mode
        For r = 1 To UBound(vStaticErrs)            ' Create dictionary of Static Errors
            .Item(vStaticErrs(r, 1)) = 0
        Next r
        ' Check if each row in vImportLog exists in the Static Errors dictionary
        ' Put the rows that don't exist in the vResults array
        For r = 1 To UBound(vImportLog) 'Next row in vImportLog
            If Not .Exists(vImportLog(r, 1) & vImportLog(r, 2) & vImportLog(r, 39)) Then 'compare columns A&B&AM
                ' Copy row to vResults
                rr = rr + 1     ' Next row in vResults
                For c = 1 To 45 ' Loop for each column
                    vResults(rr, c) = vImportLog(r, c)
                Next c
            End If
        Next r
    End With
    
    ' Paste vResults to importLog
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        rngImportLog.Value = vResults
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
    importLog.Activate
    importLog.Range("A1").Select
    Application.StatusBar = "Done"

End Sub
 
Upvote 0
Not a problem. The rest of the macro is what normally takes 5 minutes, and I was timing the run, not just the section we fixed. There are probably other things that could be improved as well, but since I have a progress bar and launch it from a template with a button, it isn't easy to send the whole thing. Fortunately, the data is not PHI or sensitive in any way.
 
Upvote 0

Forum statistics

Threads
1,224,590
Messages
6,179,753
Members
452,940
Latest member
rootytrip

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top