macro for copying background color

[MelB]

I need a macro that does the following:

If a cell contains the text "N/A" I need the background color of the cell
adjacent and to the left of it, copied and pasted into the cell with "N/A"

So, B1 has "N/A". I need the background color from A1 copied into cell B1,
leaving the text "N/A" intact.

If B2 has "N/A" I need the background or fill color from cell A2 copied into
B2.

In all cases the fill color is just a solid color. I need no other
formatting or content copied, just the fill color.

 

[OssieMac]

Hi,

I hope that I have interpreted correctly. You said contains "N/A", not
equals "N/A" meaning that it could be anywhere in a longer string. Also you
have not said that it contains the error #N/A.

Therefore macro is for what I understand although it will also work if
equals "N/A" but need a modification if it is #N/A due to a formula error.
(See below macro code)

Sub Copy_Inter_Color()

Dim rngB As Range
Dim c As Range

'Assign range of cells in column B with values to a variable
With Sheets("Sheet1")
Set rngB = .Range(.Cells(1, "B"), _
.Cells(.Rows.Count, "B").End(xlUp))
End With

For Each c In rngB
If InStr(1, c, "N/A") > 0 Then
c.Interior.Color = c.Offset(0, -1).Interior.Color
End If
Next c

End Sub



Replace the If test with the following line for #N/A error
'If WorksheetFunction.IsNA(c) Then

 

[MelB]

Thanks for the help.

Actually, I did mean equals "N/A" as in Not Applicable.

I used your code and got the following:

Runtime Error 9:
Subscript out of range.
The debugger highlights that line with sheets (Sheet 1)

Also, I should elaborate that this needs to work for the entire sheet.
Whereever "N/A" appears the background color needs to be copied from the cell
adjacent and to the left of it.

Again, thanks for the help.

 

[Dave Peterson]

You have to change this line:
With Sheets("Sheet1")
to work with the name you see in the worksheet tab in excel:
With Sheets("my worksheet name here")

 

[MelB]

I tried this. Still not working. Any other suggestions?

 

[Dave Peterson]

If you're getting the subscript out of range on that line, then you haven't
spelled the name of that worksheet correctly.

Maybe you have leading/trailing/embedded spaces that you're missing.

 

[MelB]

It is actually working.

I changed the "B's" to "F's" which is the column where the data is that this
is supposed to affect and it worked. So how do I expand this to either look
anywhere in the sheet for "N/A" or expand it to specifically run in columns:
F, I, L, O, R, U.

thanks again.

 

[OssieMac]

Hi Mel,

Two macros. The first one will work with the entire used range in the
worksheet and the second one will work with the used range in each of the
specific columns. The second one should run faster because it will process
less cells.

You will need to edit the worksheet name and insert your worksheet name.

And to thanks Dave for filling in while I was unavailable.

Sub Copy_Inter_Color_2()

Dim rngAll As Range
Dim c As Range

With Sheets("Sheet1")
Set rngAll = .UsedRange
End With

For Each c In rngAll
If InStr(1, c, "N/A") > 0 Then
c.Interior.Color = c.Offset(0, -1).Interior.Color
End If
Next c

End Sub




Sub Copy_Inter_Color_3()
Dim rngF As Range
Dim rngI As Range
Dim rngL As Range
Dim rngO As Range
Dim rngR As Range
Dim rngU As Range
Dim rngAll As Range

Dim c As Range

'Edit Sheet1 to your sheet name
With Sheets("Sheet1")
Set rngF = .Range(.Cells(1, "F"), _
.Cells(.Rows.Count, "F").End(xlUp))
Set rngI = .Range(.Cells(1, "I"), _
.Cells(.Rows.Count, "I").End(xlUp))
Set rngL = .Range(.Cells(1, "L"), _
.Cells(.Rows.Count, "L").End(xlUp))
Set rngO = .Range(.Cells(1, "O"), _
.Cells(.Rows.Count, "O").End(xlUp))
Set rngR = .Range(.Cells(1, "R"), _
.Cells(.Rows.Count, "R").End(xlUp))
Set rngU = .Range(.Cells(1, "U"), _
.Cells(.Rows.Count, "U").End(xlUp))

Set rngAll = Union(rngF, rngI, rngL, _
rngO, rngR, rngU)
End With

For Each c In rngAll
If InStr(1, c, "N/A") > 0 Then
c.Interior.Color = c.Offset(0, -1).Interior.Color
End If
Next c

End Sub