locked
Get cell formatting for row change formatting then paste back saved formatting RRS feed

  • Question

  • Thanks for taking the time to read my question.

    I have a big spreadsheet and I've made a macro that changes the row color to yellow so that I can easily follow it across the screen as I scroll left and right. It works well. I was then thinking that I could use this in many of my spreadsheets, but they all have different formatting. If I saved this in my PersonalMacro workbook and applied it to all my sheets I'd have to be able to pick up the current formatting before applying my "yellow bar" to the current row

    Is there a way I can copy the formatting of the active row, then apply my coloring, then when I leave it put the formatting back.

    The if statements are there because my first 2 rows are titles and I didn't want to change them. That part could go away. The other part of the if statement just looks to see if there is data in column A of the active row. Also not really needed.

    Here is the code I have so far:

    Dim pRow As Integer
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim tRow As Integer
    On Error GoTo SCError_Err
        'Clear yellow bar from last selection and put formatting back'
        If pRow > 2 And Cells(pRow, 1) <> "" Then
            Range("A" & pRow & ":D" & pRow).Interior.Pattern = xlNone
            Range("A" & pRow & ":D" & pRow).Interior.TintAndShade = 0
            Range("A" & pRow & ":D" & pRow).Interior.PatternTintAndShade = 0
            Range("E" & pRow & ":I" & pRow).Interior.Color = 0
            
            Range("E" & pRow & ":I" & pRow).Interior.Pattern = xlNone
            Range("E" & pRow & ":I" & pRow).Interior.TintAndShade = 0
            Range("E" & pRow & ":I" & pRow).Interior.PatternTintAndShade = 0
            Range("E" & pRow & ":I" & pRow).Interior.Color = 49407
            
            Range("J" & pRow & ":L" & pRow).Interior.Pattern = xlNone
            Range("J" & pRow & ":L" & pRow).Interior.TintAndShade = 0
            Range("J" & pRow & ":L" & pRow).Interior.PatternTintAndShade = 0
            Range("J" & pRow & ":L" & pRow).Interior.Color = 5296274
            
            Range("M" & pRow & ":N" & pRow).Interior.Pattern = xlNone
            Range("M" & pRow & ":N" & pRow).Interior.TintAndShade = 0
            Range("M" & pRow & ":N" & pRow).Interior.PatternTintAndShade = 0
            Range("M" & pRow & ":N" & pRow).Interior.Color = 15773696
            
            Range("O" & pRow & ":Y" & pRow).Interior.PatternColorIndex = xlAutomatic
            Range("O" & pRow & ":Y" & pRow).Interior.ThemeColor = xlThemeColorDark1
            Range("O" & pRow & ":Y" & pRow).Interior.TintAndShade = -0.349986266670736
            Range("O" & pRow & ":Y" & pRow).Interior.PatternTintAndShade = 0
        End If
        
    tRow = ActiveCell.Row
    pRow = tRow
        'make yellow bar'
        If tRow > 2 And Cells(tRow, 1) <> "" Then
            Range("A" & tRow & ":Y" & tRow).Interior.Pattern = xlSolid
            Range("A" & tRow & ":Y" & tRow).Interior.PatternColorIndex = xlAutomatic
            Range("A" & tRow & ":Y" & tRow).Interior.Color = 65535
            Range("A" & tRow & ":Y" & tRow).Interior.TintAndShade = 0
            Range("A" & tRow & ":Y" & tRow).Interior.PatternTintAndShade = 0
        End If
    SCError_Exit:
    Exit Sub
    SCError_Err:
    If Err.Number = 1004 Then
        pRow = 2
        Resume
    Else
        MsgBox Err.Number & ", " & Err.Description
        Resume SCError_Exit
    End If
    End Sub



    • Edited by mbrad Friday, July 20, 2012 2:30 PM
    Friday, July 20, 2012 2:28 PM

Answers

  • I didn't run your code but I have to think it makes moving about sluggish, at best.

    How about a different approach?

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Application.EnableEvents = False
        Target.EntireRow.Select
        Target.Activate
        Application.EnableEvents = True
    End Sub


    • Proposed as answer by Leo_Gao Wednesday, July 25, 2012 4:52 AM
    • Marked as answer by Leo_Gao Monday, July 30, 2012 1:24 AM
    Friday, July 20, 2012 2:44 PM

All replies

  • I didn't run your code but I have to think it makes moving about sluggish, at best.

    How about a different approach?

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Application.EnableEvents = False
        Target.EntireRow.Select
        Target.Activate
        Application.EnableEvents = True
    End Sub


    • Proposed as answer by Leo_Gao Wednesday, July 25, 2012 4:52 AM
    • Marked as answer by Leo_Gao Monday, July 30, 2012 1:24 AM
    Friday, July 20, 2012 2:44 PM
  • Have you seen this on Chandoo's site: http://chandoo.org/wp/2012/07/11/highlight-row-column-of-selected-cell-using-vba/

    Sounds like what you want to do.


    HTH,

    Eric

    Tu ne cede malis sed contra audentior ito

    Friday, July 20, 2012 3:07 PM
  • Depending on why you need the current row marked, "Freeze Panes" might work well enough?

    Friday, July 20, 2012 5:16 PM
  • Thanks for the reply Jim.

    I'm not familiar with Application.EnableEvents. What does this do?

    If I select the entire row with this code, do I have the opportunity to delete or edit anything on purpose or by mistake?

    I don't find it too slow. There is a very slight delay.

    Brad

    Friday, July 20, 2012 6:47 PM
  • Hi, thanks for the reply. This is very similar to what I want to do, but I was hoping to do something that could be applied to all my workbooks if I so choose.

    Brad

    Friday, July 20, 2012 6:48 PM
  • Hi Brian,

    Thanks for the suggestion. I do use Freeze Panes a lot. I'm actually using this in conjunction with the highlight rows code posted above.

    Brad

    Friday, July 20, 2012 6:49 PM
  • Hi,

    The Application.EnableEvents is set to enable/disable events in the macro,please refer to http://msdn.microsoft.com/en-us/library/ff821508.aspx

    Also, you can manipulate(delete or edit) the worksheet after setting the Application.EnableEvents to false.

    Hope this can help you.


    Leo_Gao [MSFT]
    MSDN Community Support | Feedback to us

    Wednesday, July 25, 2012 5:03 AM