Cannot use .Find commands as part of mini loops inside a larger loop

[iam_011]

[TABLE="width: 699"]
<tbody>[TR]
[TD]Hello all,

I am trying to write a loop with two mini internal loops as part of a larger process.

The whole major looped process is located in one sheet (“Set up”).

It is intended to take a value (starts at 1) in cell B1 and search for that value in a fixed range E3:E500. I use a formula in cell C1 to determine if that search value exists in the range or not. If not, it increases the value in B1 by 1 and searches again, increasing the value by 1 each time (1 then 2 then 3 etc.) within the first mini loop until it finds the value in search range. When it finds the first instance of the value it copies the data in same row offset by 1 to 14 columns to right of the found value. So far so good although I had to use an alternative to the .find function to get it to work (not shown here).

The process is then designed to then take the copied data and find the LAST instance of the same value in the same search range and paste the data into the corresponding offset columns to the right. This is where I have hit a dead end, as I can't find any other function than .find to get and select the location of the last instance in the range without using the .find command.

The second mini loop is then intended to find each of the instances in the range of the search value and clear the contents of the offset column until there's only one instance left (the last instance against which the data has just been copied). This is dictated by a formula in cell C1 which does the count of the value and some other criteria which I couldn't write the code for. Once there's only 1 instance of the value left, it is then supposed to exit the second loop and increase the search value in B1 by 1 and start the whole loop again to find the new value. Every time I run it the debug highlights the following rows of code which use the find command.

grprange.Find(grpnumber).Activate

Set myC = grprng.Find(grpnumber, , , , , xlPrevious)

It throws up the following error message "Run-time error '91': Object variable or With block variable not set". I assume this is because the find function is now fragmenting the loop functions.

Below is code, please let me know where / why I am going wrong and if there’s an alternative (I am sure there is) which someone of my limited vba skills could use.

Thanks

Dim countocc As Range
Dim endproc As Range
Dim grprng As Range
Dim grpnumber As String
Dim grpnum As Range

grpnumber = ThisWorkbook.Worksheets("Set Up").Range("$B$1")
Set grpnum = ThisWorkbook.Worksheets("Set Up").Range("$B$1")

Set endproc = ThisWorkbook.Worksheets("Set Up").Range("$A$1")
Set countocc = ThisWorkbook.Worksheets("Set Up").Range("$C$1")

‘main loop start
Do While grpnum <= endproc

‘mini loop 1 start

Do While countocc = 0

grpnum.Value = grpnum + 1

Loop

Set grprng = ThisWorkbook.Worksheets("Set Up").Range("E3:E500")
grpnumber = ThisWorkbook.Worksheets("Set Up").Range("$B$1")

grprange.Find(grpnumber).Activate

Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 14)).Copy

Dim myC As Range
Set myC = grprng.Find(grpnumber, , , , , xlPrevious)

myC.Activate

ActiveCell.Offset(0, 1).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

grprng.Find(grpnumber).Select

Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 14)).Select
Selection.ClearContents

‘mini loop 2 start

Dim r As Range
Dim v As Variant

For Each r In Intersect(Range("E2:E500"), ActiveSheet.UsedRange)
v = r.Value
If Range("$C$1") = 1 Then Exit For
If InStr(v, grpnumber) > 0 Then
r.Select
Range(Selection.Offset(0, 1), Selection.Offset(0, 14)).ClearContents
End If

Next r

Range("B1").Select
Selection.Value = Range("B1") + 1

Loop
[/TD]
[/TR]
</tbody>[/TABLE]

 

[baitmaster]

welcome to the board

The most obvious issue I can see is that you've declared one of your objects incorrectly. This was able to occur because you didn't force variable declaration (VB Editor > Tools > Options > Require variable declaration), by adding "option explicit" to the top of your code module. This is useful because it forces you to declare variables properly, and in your case would have warned you that the variable grprange had not been declared, because it was a misspelling of grprng

I've taken the liberty of re-writing your code a little, to simplify how the range objects are created and used; to remove all instances of "select" which is completely unnecessary, and to break out the FIND features so that if they fail you will get meaningful error messages - so if there's something else wrong with your FIND as well as this invalid range object, you should be able to spot it more easily

My code is untested so use carefully, i.e. not on your original data

Option Explicit
Sub blah()

' create range objects
Dim rngEndProc As Range:    Set rngEndProc = ThisWorkbook.Worksheets("Set Up").Range("$A$1")
Dim rngGrpNum As Range:     Set rngGrpNum = ThisWorkbook.Worksheets("Set Up").Range("$B$1")
Dim rngCountOcc As Range:   Set rngCountOcc = ThisWorkbook.Worksheets("Set Up").Range("$C$1")
Dim rngGrp As Range:        Set rngGrp = ThisWorkbook.Worksheets("Set Up").Range("E3:E500")
Dim rngCopyStart As Range, rngPasteLocation As Range, rngToClear As Range
Dim r As Range
Dim strGrpNumber As String: strGrpNumber = rngGrpNum.Value

'main loop start
Do While rngGrpNum <= rngEndProc

    'mini loop 1 start
    Do While rngCountOcc = 0
        rngGrpNum.Value = rngGrpNum.Value + 1
    Loop
    strGrpNumber = rngGrpNum.Value
    
    ' attempt to get start of copy range
    On Error Resume Next
        Set rngCopyStart = rngGrp.Find(strGrpNumber) ' original row had incorrectly declared variable
    On Error GoTo 0
    
    ' end if unable to get copy range
    If rngCopyStart Is Nothing Then
        MsgBox "ERROR: unable to locate copy range", vbCritical
        Exit Sub
    End If
    
    ' attempt to get paste location
    On Error Resume Next
        Set rngPasteLocation = rngGrp.Find(strGrpNumber, , , , , xlPrevious)
    On Error GoTo 0
    
    ' end if unable to get paste range
    If rngPasteLocation Is Nothing Then
        MsgBox "ERROR: unable to locate paste range", vbCritical
        Exit Sub
    End If
    
    ' copy & paste
    Range(rngCopyStart.Offset(0, 1), rngCopyStart.Offset(0, 14)).Copy
    rngPasteLocation.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    ' clear values
    Range(rngCopyStart.Offset(0, 1), rngCopyStart.Offset(0, 14)).ClearContents
    
'mini loop 2 start
    For Each r In Intersect(Range("E2:E500"), ActiveSheet.UsedRange) ' should this be rngGrp? E2:E500 or E3:E500?
        
        If Range("$C$1") = 1 Then Exit For
        
        If InStr(r.Value, strGrpNumber) > 0 Then
            Range(r.Offset(0, 1), r.Offset(0, 14)).ClearContents
        End If
    
    Next r
    
    rngGrpNum.Value = rngGrpNum.Value + 1
Loop

End Sub

 

[iam_011]

That is fantastic Baitmaster G, worked like a charm. Thanks so much for investing some time in not just identifying where I had gone wrong but also in making proposed improvements. Have a great weekend.