Odtnhj

I've tried searching for this but have only ended up with a non-functioning Frankenstein sub routine. I need to:

-Filter Column B to Grey Cells.

-In column AB on all visible rows, set formula equal to the values in Column B.
If a row is filtered out, I need it to remain blank.

Bonus question (because I'm a pain in the neck): I need to do some kind of loop to replicate this process in columns AC:BA as well. For example, filter Column C to grey cells, and make all visible cells in AC equal to the corresponding row in Column C.

EDIT: I was also thinking to just do a Control + Find, replace any cell where the background color is no fill, and replace with a blank or 0. I can't get that to work either, however.

Code that I have (currently I'm stuck at having selected the first visible cell in Column AB):

Dim Last_Cell As Range
 Set Last_Cell = Range("A3").SpecialCells(xlLastCell)

 ' [Good ]Filter Column B by Color
 Range("$A$3", Last_Cell).AutoFilter Field:=2, Criteria1:=RGB(165,165,_ 
165), Operator:=xlFilterCellColor

 ' [Pending ] Set all visible AB cells = same row in B
 Range("AB3").Offset(1, 0).Activate
 Do Until Selection.EntireRow.Hidden = False
 If Selection.EntireRow.Hidden = True Then
 ActiveCell.Offset(1, 0).Activate
 End If
 Loop

Here's some code for you to tinker with.

The sub below takes 4 arguments: the whole filter column, the whole formula column, the row number of the filter headers, and the RGB color to look for.

'ASSUMPTION: prngFilterCol is to the left of prngFormulaCol.
Public Sub FilterByColorThenSetFormulas(ByVal prngFilterCol As Excel.Range, ByVal prngFormulaCol As Excel.Range, ByVal plHeaderRow As Long, ByVal plColorRGB As Long)
 Dim rngFirstCellInFilterArea As Excel.Range
 Dim rngLastCellInFilterArea As Excel.Range
 Dim rngFilterTarget As Excel.Range
 Dim rngFormulasTarget As Excel.Range
 Dim rngVisibleCells As Excel.Range
 Dim lColumnsDifference As Long

 'Initialization.
 Set rngFirstCellInFilterArea = prngFilterCol.Cells(plHeaderRow, 1)
 Set rngLastCellInFilterArea = Application.Intersect(rngFirstCellInFilterArea.SpecialCells(xlLastCell).EntireRow, prngFormulaCol)
 lColumnsDifference = prngFilterCol.Column - prngFormulaCol.Column

 'Remove existing filtering.
 prngFilterCol.Worksheet.AutoFilterMode = False

 If rngLastCellInFilterArea.Row > plHeaderRow Then
 Set rngFilterTarget = prngFilterCol.Worksheet.Range(rngFirstCellInFilterArea, rngLastCellInFilterArea)

 'Clear the contents (formulas) in the target column.
 'Our assumption (above) is crucial.
 Set rngFormulasTarget = rngFilterTarget.Columns(rngFilterTarget.Columns.Count)
 rngFormulasTarget.ClearContents

 'Filter.
 rngFilterTarget.AutoFilter Field:=1, Criteria1:=plColorRGB, Operator:=xlFilterCellColor

 'Find the remaining visible cells.
 'Note: SpecialCells will fail if there are no visible cells, hence the On Error Resume Next.
 Set rngVisibleCells = Nothing
 On Error Resume Next
 Set rngVisibleCells = rngFilterTarget.Offset(1).Resize(rngFilterTarget.Rows.Count - 1).SpecialCells(XlCellType.xlCellTypeVisible)
 On Error GoTo 0

 If Not rngVisibleCells Is Nothing Then
 'Assign formulas to the visible cells within prngFormulaCol, using the relative notation of FormulaR1C1.
 rngFormulasTarget.FormulaR1C1 = "=R[0]C[" & CStr(lColumnsDifference) & "]"
 End If
 End If

 'Cleanup.
 prngFilterCol.Worksheet.AutoFilterMode = False
 Set rngFormulasTarget = Nothing
 Set rngVisibleCells = Nothing
 Set rngFilterTarget = Nothing
 Set rngLastCellInFilterArea = Nothing
 Set rngFirstCellInFilterArea = Nothing
End Sub

You can invoke it as follows:

Public Sub TestFilterByColorThenSetFormulas()
 Dim lColIndex As Long

 'Example 1.
 'Column 2 is B, column 28 is AB.
 FilterByColorThenSetFormulas Sheet1.Columns(2), Sheet1.Columns(28), 3, RGB(165, 165, 165)

 'Example 2.
 'Loop from column B to Z, putting formulas in columns AB to AZ.
 For lColIndex = 2 To 26
 FilterByColorThenSetFormulas Sheet1.Columns(lColIndex), Sheet1.Columns(lColIndex + 26), 3, RGB(165, 165, 165)
 Next
End Sub

I trust you will find your way around the code. Try it out, put some breakpoints, see how it works, and have fun.

Note that the code leaves the target worksheet unfiltered. If you'd like filters to stay, you can re-establish them afterwards, programmatically. I'll leave this as an exercise ;-)

Below is my test worksheet's setup: