adjust vba to select colored cells

andrewb90

Well-known Member
Joined
Dec 16, 2009
Messages
1,077
Hello all,

I have a code that should be looking for cells on my sheet that have a certain fill color. then filling in other cells on another sheet in a different color. However, for some reason my code is only looking at whatever cell is selected. Any help in the right direction would be greatly appreciated.

Code:
Sub Reset_MasterAvail()Dim I As Integer
Dim j As Integer
Dim objColorStop As ColorStop
Dim mySelect As Range
Dim myOthershtRng As Range


Set myOthershtRng = Sheets("Scheduler").Range(Selection.Address)


For I = 88 To 207
    If I = 88 Or I = 107 Or I = 126 Or I = 145 Or I = 164 Or I = 193 Then 'skipped rows
        GoTo Next1
    Else
        For j = 5 To 18 Step 2 ' j is column #
            If Sheets("Master Availability").Cells(I, j).Interior.Color = RGB(255, 192, 0) And Sheets("Master Availability").Cells(I, j + 1).Interior.Color = RGB(255, 192, 0) Then
               With Sheets("Master Availability").Cells.Select
               End With
               'With Sheets("Scheduler") ' code below offsets rows and columns instead of mirroring exact cell#
                With myOthershtRng.Interior
                .Pattern = xlPatternRectangularGradient 'Gray Gradient
                .Gradient.RectangleLeft = 0.5
                .Gradient.RectangleRight = 0.5
                .Gradient.RectangleTop = 0.5
                .Gradient.RectangleBottom = 0.5
                .Gradient.ColorStops.clear
                End With
    
                Set objColorStop = myOthershtRng.Interior.Gradient.ColorStops.Add(0)
                With objColorStop
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
                End With
    
                Set objColorStop = myOthershtRng.Interior.Gradient.ColorStops.Add(1)
                With objColorStop
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = -0.349009674367504
                End With
            
            End If
        Next j
    End If
Next1:
Next I
End Sub
 
Hello all,

I have a code that should be looking for cells on my sheet that have a certain fill color. then filling in other cells on another sheet in a different color. However, for some reason my code is only looking at whatever cell is selected. Any help in the right direction would be greatly appreciated.

Code:
Sub Reset_MasterAvail()Dim I As Integer
Dim j As Integer
Dim objColorStop As ColorStop
Dim mySelect As Range
Dim myOthershtRng As Range


Set myOthershtRng = Sheets("Scheduler").Range(Selection.Address)


For I = 88 To 207
    If I = 88 Or I = 107 Or I = 126 Or I = 145 Or I = 164 Or I = 193 Then 'skipped rows
        GoTo Next1
    Else
        For j = 5 To 18 Step 2 ' j is column #
            If Sheets("Master Availability").Cells(I, j).Interior.Color = RGB(255, 192, 0) And Sheets("Master Availability").Cells(I, j + 1).Interior.Color = RGB(255, 192, 0) Then
               With Sheets("Master Availability").Cells.Select
               End With
               'With Sheets("Scheduler") ' code below offsets rows and columns instead of mirroring exact cell#
                With myOthershtRng.Interior
                .Pattern = xlPatternRectangularGradient 'Gray Gradient
                .Gradient.RectangleLeft = 0.5
                .Gradient.RectangleRight = 0.5
                .Gradient.RectangleTop = 0.5
                .Gradient.RectangleBottom = 0.5
                .Gradient.ColorStops.clear
                End With
    
                Set objColorStop = myOthershtRng.Interior.Gradient.ColorStops.Add(0)
                With objColorStop
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
                End With
    
                Set objColorStop = myOthershtRng.Interior.Gradient.ColorStops.Add(1)
                With objColorStop
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = -0.349009674367504
                End With
            
            End If
        Next j
    End If
Next1:
Next I
End Sub
Hi Andrew,

I think it will be this line of code causing your problem:

Set myOthershtRng = Sheets("Scheduler").Range(Selection.Address)

Personally I would try rewording this line and moving it elsewhere in the code as follows:

Rich (BB code):
Sub Reset_MasterAvail()
Dim I As Integer
Dim j As Integer
Dim objColorStop As ColorStop
Dim mySelect As Range
Dim myOthershtRng As Range


For I = 88 To 207
    If I = 88 Or I = 107 Or I = 126 Or I = 145 Or I = 164 Or I = 193 Then 'skipped rows
        GoTo Next1
    Else
        For j = 5 To 18 Step 2 ' j is column #
            If Sheets("Master Availability").Cells(I, j).Interior.Color = RGB(255, 192, 0) And Sheets("Master Availability").Cells(I, j + 1).Interior.Color = RGB(255, 192, 0) Then
               With Sheets("Master Availability").Cells.Select
               End With
               
               Set myOthershtRng = Sheets("Scheduler").Cells(I, j)
               
               'With Sheets("Scheduler") ' code below offsets rows and columns instead of mirroring exact cell#
                With myOthershtRng.Interior
                .Pattern = xlPatternRectangularGradient 'Gray Gradient
                .Gradient.RectangleLeft = 0.5
                .Gradient.RectangleRight = 0.5
                .Gradient.RectangleTop = 0.5
                .Gradient.RectangleBottom = 0.5
                .Gradient.ColorStops.Clear
                End With
    
                Set objColorStop = myOthershtRng.Interior.Gradient.ColorStops.Add(0)
                With objColorStop
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
                End With
    
                Set objColorStop = myOthershtRng.Interior.Gradient.ColorStops.Add(1)
                With objColorStop
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = -0.349009674367504
                End With
            
            End If
        Next j
    End If
Next1:
Next I
End Sub
 
Upvote 0
Alright, I made the change, and to some degree it works, but it's not doing what I expected.
when the code runs, every cell in my range that has those Interior color characteristics, should then have the matching cell on the scheduler page filled in with the gradient color.
 
Upvote 0
Alright, I made the change, and to some degree it works, but it's not doing what I expected.
when the code runs, every cell in my range that has those Interior color characteristics, should then have the matching cell on the scheduler page filled in with the gradient color.
Hmm, are you able to share an example workbook with us to test in? If so then you will need to upload a copy to a file hosting site such as Drop Box, One Drive, Google Drive or similar, then share a link to the file in a forum post.
 
Upvote 0

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