Macro unexpectedly clears colour from cells

[Norbury]

Hi, I have a short macro which I want to work only when a cell isn't coloured. It does generally work as expected, but when the cells are coloured it strips the colour out for some reason. The purpose of the macro is to reinstate an equation previously deleted, by copying the first non-blank cell directly above. When the cell (i,42) has a colour then equation isn't pasted in, but the colour still disappears, and I can't work out why. Can anyone explain it to me, please? Here is the important part of the code.

For i = rowno1 To rowno2
    Cells(i, 42).Select
        If Selection.Interior.ColorIndex = xlNone Then
            x = Range("AP" & rown1).End(xlUp).Row
            Range("AP" & x).Copy destination:=Range(Cells(rown1, col), Cells(rown2, col))
        End If
Next i

I can probably do a workaround by selecting the cell next door and pasting the colour from there, but I wish I knew why it was happening.

 

[Andrew Poulsom]

Where are you assigning values to the variables rown1, rown2 and col? Copying overwrites any existing formats.

 

[VoG]

And shouldn't it be

x = Range("AP" & rowno1).End(xlUp).Row

 

[JackDanIce]

Probably help you post your whole code, but this may work:

For i = rowno1 To rowno2
    If Cells(i, 42).Interior.ColorIndex = xlNone Then
        x = Range("AP" & rowno1).End(xlUp).Row
        Range("AP" & x).Copy
        With Range(Cells(rown1, col), Cells(rown2, col))
            .PasteSpecial Paste:=xlValues
            .PasteSpecial Paste:=xlFormats
        End With
    End If
Next i

 

[Norbury]

Thanks for pointing out my typo (now fixed), but I've just realised that the problem is that I was pasting into the whole range for every i. I'm now pasting into each cell individually and the problem has gone away.

 

[Norbury]

Full working code:

    Do
        rowno1$ = InputBox("First row of cell(s) to be reinstated")
        If rowno1$ = "" Then GoTo skip
        rown1 = Val(rowno1$)
        rowno2$ = InputBox("Last row of cells to be reinstated", , rowno1$)
            If rowno2$ = "" Then
                rown2 = Val(rowno1$)
                Else: rown2 = Val(rowno2$)
            End If
        If rown1 > Cells(3, 17) Then
            MsgBox ("Can't work below the last line")
            GoTo Lp1
        End If
        If rown2 > Cells(3, 17) Then
            MsgBox ("Can't work below the last line")
            GoTo Lp1
        End If
        For i = rown1 To rown2
            Cells(i, 42).Select
            If Selection.Interior.ColorIndex = xlNone Then
                x = Range("AP" & rown1).End(xlUp).Row
                Range("AP" & x).Copy destination:=Range("AP" & i)
            End If
        Next i
            
Lp1:  Loop

 

[JackDanIce]

You could reduce

        If rown1 > Cells(3, 17) Then
            MsgBox ("Can't work below the last line")
            GoTo Lp1
        End If
        If rown2 > Cells(3, 17) Then
            MsgBox ("Can't work below the last line")
            GoTo Lp1
        End If

To

        If rown1 > Cells(3, 17) Or rown2 > Cells(3, 17) Then
            MsgBox ("Can't work below the last line")
            GoTo Lp1
        End If

 

[Norbury]

Thank you, will do. I will be going on a course to learn VBA properly in a couple of months, hopefully I'll start writing more compact code then. Until then (and probably still afterwards) this website/message board is invaluable.

 

[JackDanIce]

Apart from Excel 2007 VBA Programming for Dummies by John Walkenbach, everything else I've learnt has been via this board or general internet searches. Do highly recommend that book though