Skip multiple empty cells in loop

M

mmckay1

New Member
Joined
Mar 29, 2012
Messages
31
I want to leave empty spaces in this spreadsheet for consumable items in an inventory system. It highlights different sections of quantity values with varying minimums. I want to be able to leave up to 10 cells blank in the loop but if i have more than one or two it crashes out. i only started getting this error after adding extra rows to allow for items in the range to be added later. here is the error: runtime error 91 : object variable or with block variable not set

here is the code i am using to select the different values and highlight them
Code: 
Sub milling_inserts()
    
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
    MyCount = 1
    For Each cell In Range("C8:C12")
        If cell.Value <> "" Then
            If cell.Value <= 10 Then
                If MyCount = 1 Then Set NewRange = cell
                Set NewRange = Application.Union(NewRange, cell)
                MyCount = MyCount + 1
            End If
        End If
    Next cell
    NewRange.Interior.ColorIndex = 3
    For Each cell In Range("C13:C46")
        If cell.Value <> "" Then
            If cell.Value <= 15 Then
                If MyCount = 1 Then Set NewRange = cell
                Set NewRange = Application.Union(NewRange, cell)
                MyCount = MyCount + 1
            End If
        End If
    Next cell
    NewRange.Interior.ColorIndex = 3
    For Each cell In Range("C53:C63")
        If cell.Value <> "" Then
            If cell.Value <= 5 Then
                If MyCount = 1 Then Set NewRange = cell
                Set NewRange = Application.Union(NewRange, cell)
                MyCount = MyCount + 1
            End If
        End If
    Next cell
    NewRange.Interior.ColorIndex = 3
    For Each cell In Range("G8:G24")
        If cell.Value <> "" Then
            If cell.Value <= 10 Then
                If MyCount = 1 Then Set NewRange = cell
                Set NewRange = Application.Union(NewRange, cell)
                MyCount = MyCount + 1
            End If
        End If
    Next cell
    NewRange.Interior.ColorIndex = 3
    For Each cell In Range("G30:G44")
        If cell.Value <> "" Then
            If cell.Value <= 5 Then
                If MyCount = 1 Then Set NewRange = cell
                Set NewRange = Application.Union(NewRange, cell)
                MyCount = MyCount + 1
            End If
        End If
    Next cell
    NewRange.Interior.ColorIndex = 3
        For Each cell In Range("G51:G63")
        If cell.Value <> "" Then
            If cell.Value <= 10 Then
                If MyCount = 1 Then Set NewRange = cell
                Set NewRange = Application.Union(NewRange, cell)
                MyCount = MyCount + 1
            End If
        End If
    Next cell
    NewRange.Interior.ColorIndex = 3
        For Each cell In Range("K8:K24")
        If cell.Value <> "" Then
            If cell.Value <= 10 Then
                If MyCount = 1 Then Set NewRange = cell
                Set NewRange = Application.Union(NewRange, cell)
                MyCount = MyCount + 1
            End If
        End If
    Next cell
    NewRange.Interior.ColorIndex = 3
    For Each cell In Range("K30:K44")
        If cell.Value <> "" Then
            If cell.Value <= 15 Then
                If MyCount = 1 Then Set NewRange = cell
                Set NewRange = Application.Union(NewRange, cell)
                MyCount = MyCount + 1
            End If
        End If
    Next cell
    NewRange.Interior.ColorIndex = 3
    For Each cell In Range("K50:K63")
        If cell.Value <> "" Then
            If cell.Value <= 10 Then
                If MyCount = 1 Then Set NewRange = cell
                Set NewRange = Application.Union(NewRange, cell)
                MyCount = MyCount + 1
            End If
        End If
    Next cell
    NewRange.Interior.ColorIndex = 3
    
End Sub
Like i said this WAS totally working untill i added extra rows between ranges. is there a quick fix to this or will i have to re-do everything? if thats the case ill make do without the extra room and teach the next person to use this how to add a range.
thanks in advance
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Sort by date Sort by votes
IF IT HELPS i even tried to just make the range like this
Code: 
Sub button_inserts()
    
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
    MyCount = 1
    For Each cell In Range("C8:C94")
        If cell.Value <> "" Then
            If cell.Value <= 10 Then
                If MyCount = 1 Then Set NewRange = cell
                Set NewRange = Application.Union(NewRange, cell)
                MyCount = MyCount + 1
            End If
        End If
    Next cell
    NewRange.Interior.ColorIndex = 3
    For Each cell In Range("G8:G94")
        If cell.Value <> "" Then
            If cell.Value <= 10 Then
                If MyCount = 1 Then Set NewRange = cell
                Set NewRange = Application.Union(NewRange, cell)
                MyCount = MyCount + 1
            End If
        End If
    Next cell
    For Each cell In Range("K8:K94")
        If cell.Value <> "" Then
            If cell.Value <= 10 Then
                If MyCount = 1 Then Set NewRange = cell
                Set NewRange = Application.Union(NewRange, cell)
                MyCount = MyCount + 1
            End If
        End If
    Next cell
    NewRange.Interior.ColorIndex = 3
    
       
End Sub

and im getting the error when it gets to the line that reads NewRange.Interior.ColorIndex = 3 after the first range in the "C" column
 
Upvote 0
I am not sure why the empty cells have that effect, but VBA does not like them with that union statement. You can run the same code by just ignoring the blank cells with the If statement added as shown below:

Code:
Sub milling_inserts()

Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1
For Each cell In Range("C8:C12")
If Not cell Is Nothing Then
If cell.Value <> "" Then
If cell.Value <= 10 Then
If MyCount = 1 Then Set NewRange = cell
Set NewRange = Application.Union(NewRange, cell)
MyCount = MyCount + 1
End If
End If
End If
Next cell
NewRange.Interior.ColorIndex = 3
For Each cell In Range("C13:C46")
If Not cell Is Nothing Then
If cell.Value <> "" Then
If cell.Value <= 15 Then
If MyCount = 1 Then Set NewRange = cell
Set NewRange = Application.Union(NewRange, cell)
MyCount = MyCount + 1
End If
End If
End If
Next cell
NewRange.Interior.ColorIndex = 3
For Each cell In Range("C53:C63")
If Not cell Is Nothing Then
If cell.Value <> "" Then
If cell.Value <= 5 Then
If MyCount = 1 Then Set NewRange = cell
Set NewRange = Application.Union(NewRange, cell)
MyCount = MyCount + 1
End If
End If
End If
Next cell
NewRange.Interior.ColorIndex = 3
For Each cell In Range("G8:G24")
If Not cell Is Nothing Then
If cell.Value <> "" Then
If cell.Value <= 10 Then
If MyCount = 1 Then Set NewRange = cell
Set NewRange = Application.Union(NewRange, cell)
MyCount = MyCount + 1
End If
End If
End If
Next cell
NewRange.Interior.ColorIndex = 3
For Each cell In Range("G30:G44")
If Not cell Is Nothing Then
If cell.Value <> "" Then
If cell.Value <= 5 Then
If MyCount = 1 Then Set NewRange = cell
Set NewRange = Application.Union(NewRange, cell)
MyCount = MyCount + 1
End If
End If
End If
Next cell
NewRange.Interior.ColorIndex = 3
For Each cell In Range("G51:G63")
If Not cell Is Nothing Then
If cell.Value <> "" Then
If cell.Value <= 10 Then
If MyCount = 1 Then Set NewRange = cell
Set NewRange = Application.Union(NewRange, cell)
MyCount = MyCount + 1
End If
End If
End If
Next cell
NewRange.Interior.ColorIndex = 3
For Each cell In Range("K8:K24")
If Not cell Is Nothing Then
If cell.Value <> "" Then
If cell.Value <= 10 Then
If MyCount = 1 Then Set NewRange = cell
Set NewRange = Application.Union(NewRange, cell)
MyCount = MyCount + 1
End If
End If
End If
Next cell
NewRange.Interior.ColorIndex = 3
For Each cell In Range("K30:K44")
If Not cell Is Nothing Then
If cell.Value <> "" Then
If cell.Value <= 15 Then
If MyCount = 1 Then Set NewRange = cell
Set NewRange = Application.Union(NewRange, cell)
MyCount = MyCount + 1
End If
End If
End If
Next cell
NewRange.Interior.ColorIndex = 3
For Each cell In Range("K50:K63")
If Not cell Is Nothing Then
If cell.Value <> "" Then
If cell.Value <= 10 Then
If MyCount = 1 Then Set NewRange = cell
Set NewRange = Application.Union(NewRange, cell)
MyCount = MyCount + 1
End If
End If
End If
Next cell
NewRange.Interior.ColorIndex = 3
End Sub
Code:
 
Upvote 0
well somebody on another message board gave me this code

Code: 
<code>Sub aa()  Dim NewRange, cell As Range Dim MyCount As Long     MyCount = 1     For Each cell In Union(Range("G8:G94"), Range("C8:C94"), Range("K8:K94"))        If cell.Value <> "" Then             If cell.Value <= 10 Then             cell.Interior.ColorIndex = 3             MyCount = MyCount + 1            End If         End If     Next cell End Sub</code></pre>

i want to just add a 2nd section so i can have a second "

<code>"If cell.Value <= 10 Then" in it. any ideas?</code></pre>
 
Upvote 0
You're not resetting MyCount to 1 after each loop.

So when it gets to the 2nd loop, MyCount is > 1 so
If MyCount = 1 will never be true.
So the NewRange still contains all cells from previous loop.

so you have to add MyCount = 1 Between each Loop.
 
Upvote 0
mmckay1 said:
im still getting the error at the same spot where the colour index changes. argh
Click to expand...


I might have missed something, but would this not do what you want?

Code:
Sub milling_inserts()
Dim cell As Range
Dim MyCount As Long
For Each cell In Range("C8:C12")
If cell.Value <> "" Then
If cell.Value <= 10 Then
cell.Interior.ColorIndex = 3
End If
End If
Next cell
For Each cell In Range("C13:C46")
If cell.Value <> "" Then
If cell.Value <= 15 Then
cell.Interior.ColorIndex = 3
End If
End If
Next cell
For Each cell In Range("C53:C63")
If cell.Value <> "" Then
If cell.Value <= 5 Then
cell.Interior.ColorIndex = 3
End If
End If
Next cell
For Each cell In Range("G8:G24")
If cell.Value <> "" Then
If cell.Value <= 10 Then
cell.Interior.ColorIndex = 3
End If
End If
Next cell
For Each cell In Range("G30:G44")
If cell.Value <> "" Then
If cell.Value <= 5 Then
cell.Interior.ColorIndex = 3
End If
End If
Next cell
For Each cell In Range("G51:G63")
If cell.Value <> "" Then
If cell.Value <= 10 Then
cell.Interior.ColorIndex = 3
End If
End If
Next cell
For Each cell In Range("K8:K24")
If cell.Value <> "" Then
If cell.Value <= 10 Then
cell.Interior.ColorIndex = 3
End If
End If
Next cell
For Each cell In Range("K30:K44")
If cell.Value <> "" Then
If cell.Value <= 15 Then
cell.Interior.ColorIndex = 3
End If
End If
Next cell
For Each cell In Range("K50:K63")
If cell.Value <> "" Then
If cell.Value <= 10 Then
cell.Interior.ColorIndex = 3
End If
End If
Next cell
End Sub
Code:
 
Upvote 0
ok that is working now. i was hoping to use the shortened code i found but on this sheet it seems like thats where i stand. your code works thank you very much
 
Upvote 0
mmckay1 said:
ok that is working now. i was hoping to use the shortened code i found but on this sheet it seems like thats where i stand. your code works thank you very much
Click to expand...

Happy to help
Regards, JLG
 
Upvote 0
Considering each loop is doing EXACTLY the same thing, just on a different range..and comparing <= 5 10 or 15

Try

Code: 
Sub test()
Dim c As Range
For Each c In Range("C53:C63, G30:G44")
    If c.Value <> "" And c.Value <= 5 Then
        c.Interior.ColorIndex = 3
    End If
Next c
For Each c In Range("C8:C12, G8:G24, G51:G63, K8:K24, K50:K63")
    If c.Value <> "" And c.Value <= 10 Then
        c.Interior.ColorIndex = 3
    End If
Next c
For Each c In Range("C13:C46, K30:K44")
    If c.Value <> "" And c.Value <= 15 Then
        c.Interior.ColorIndex = 3
    End If
Next c
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
CSV export to remove column
Replies
1
Views
85
StellarRumble59
S
T
  • Question
vLookup Generation
Replies
3
Views
499
StephenCrump
S
B
  • Question
Copy formula into a cell using vba
2
Replies
11
Views
432
BobtBuilder
B
S
  • Solved
Combine two codes in one worksheet change events
Replies
3
Views
257
Alex Blakenburg
A
tabbytomo
  • Solved
Copy entire row if cell has specific value, looking at multiple columns and worksheets.
Replies
2
Views
286
NateSC
NateSC

Forum statistics

Threads
1,214,826
Messages
6,121,792
Members
449,048
Latest member
greyangel23

Share this page

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