adjust vba to select colored cells

[andrewb90]

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.

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

 

[Fishboy]

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.

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:

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

 

[andrewb90]

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.

 

[Fishboy]

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.