Macro to reformat

[TWienholz]

Hey guys! Can someone please help me with a macro I'm having issues with. I've created a macro that will reformat a cell in a protected sheet to it's original formatting, however it's only working in the cells that I initially recorded the macro in. I need it to work anywhere on the sheet when necessary. I have been experimenting with the range values to try and get this to work, but it's been to no avail. Can someone please help. Here is the current VBA code:
Sub ReformatCell()
'
' ReformatCell Macro
' This macro reformats a cell to its original formatting
'
' Keyboard Shortcut: Ctrl+y
'
Range("C20:d20").Select
Sheets("DTP Audit Checklist").Select
ActiveSheet.Unprotect
Range("C22:G22").Select
Selection.Copy
Range("C20:d20").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.ClearContents
Sheets("DTP Audit Checklist").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
End Sub

The cells I am trying to target are c20:d20 through c84:d84 and then ag20:ai20 through ag91:ai91. Please let me know if I need to clarify anything, but I would appreciate any help you can offer. Thank you so much!

 

[iggydarsa]

If you want only selected cells to be affected by the macro change your code where it says "Range("C20:d20")." to "Selection."

 

[TWienholz]

If you want only selected cells to be affected by the macro change your code where it says "Range("C20:d20")." to "Selection."

Thank you for getting back to me! I actually want this macro to work in all cells marked DTP and QC since they will essentially be check boxes to be filled in by two different users. so it would be multiple rows in columns C and D as well as multiple rows in columns AG and AI.

 

[rlv01]

The cells I am trying to target are c20:d20 through c84:d84 and then ag20:ai20 through ag91:ai91.

Sub ReformatCell()
    '
    ' ReformatCell Macro
    ' This macro reformats a cell to its original formatting
    '
    ' Keyboard Shortcut: Ctrl+y
    '

    Dim WS As Worksheet
    Dim rngSourceFormat As Range
    Dim rngDestFormat As Range
    
    Set WS = Sheets("DTP Audit Checklist")
    
    WS.Activate
    WS.Unprotect
    
    Set rngSourceFormat = WS.Range("C22:G22") '<- source of the "good" formatting to copy
    
    Set rngDestFormat = WS.Range("C20:D84") 'range has 2 columns
    With rngDestFormat
        rngSourceFormat.Resize(, .Columns.Count).Copy
        .PasteSpecial Paste:=xlPasteFormats
        .ClearContents    'optional
    End With
    
    Set rngDestFormat = WS.Range("AG20:AI91") 'range has 3 columns
    With rngDestFormat
        rngSourceFormat.Resize(, .Columns.Count).Copy
        .PasteSpecial Paste:=xlPasteFormats
        .ClearContents    'optional
    End With
    
    Application.CutCopyMode = False
    WS.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
End Sub

 

[TWienholz]

Sub ReformatCell()
    '
    ' ReformatCell Macro
    ' This macro reformats a cell to its original formatting
    '
    ' Keyboard Shortcut: Ctrl+y
    '

    Dim WS As Worksheet
    Dim rngSourceFormat As Range
    Dim rngDestFormat As Range
  
    Set WS = Sheets("DTP Audit Checklist")
  
    WS.Activate
    WS.Unprotect
  
    Set rngSourceFormat = WS.Range("C22:G22") '<- source of the "good" formatting to copy
  
    Set rngDestFormat = WS.Range("C20:D84") 'range has 2 columns
    With rngDestFormat
        rngSourceFormat.Resize(, .Columns.Count).Copy
        .PasteSpecial Paste:=xlPasteFormats
        .ClearContents    'optional
    End With
  
    Set rngDestFormat = WS.Range("AG20:AI91") 'range has 3 columns
    With rngDestFormat
        rngSourceFormat.Resize(, .Columns.Count).Copy
        .PasteSpecial Paste:=xlPasteFormats
        .ClearContents    'optional
    End With
  
    Application.CutCopyMode = False
    WS.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
End Sub

Thanks RLV! I copy and pasted your code into my VBA and it came back with the following error:

 

[TWienholz]

Sub ReformatCell()
    '
    ' ReformatCell Macro
    ' This macro reformats a cell to its original formatting
    '
    ' Keyboard Shortcut: Ctrl+y
    '

    Dim WS As Worksheet
    Dim rngSourceFormat As Range
    Dim rngDestFormat As Range
   
    Set WS = Sheets("DTP Audit Checklist")
   
    WS.Activate
    WS.Unprotect
   
    Set rngSourceFormat = WS.Range("C22:G22") '<- source of the "good" formatting to copy
   
    Set rngDestFormat = WS.Range("C20:D84") 'range has 2 columns
    With rngDestFormat
        rngSourceFormat.Resize(, .Columns.Count).Copy
        .PasteSpecial Paste:=xlPasteFormats
        .ClearContents    'optional
    End With
   
    Set rngDestFormat = WS.Range("AG20:AI91") 'range has 3 columns
    With rngDestFormat
        rngSourceFormat.Resize(, .Columns.Count).Copy
        .PasteSpecial Paste:=xlPasteFormats
        .ClearContents    'optional
    End With
   
    Application.CutCopyMode = False
    WS.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
End Sub

Good morning RLV01. I also wanted to mention that that error msg popped up when I tried to run the macro while in the VBA, but when I exited it and just ran it on the sheet it sort of worked? It is reformatting all of those cells at once when I only need it to reformat a cell if the user uses another macro in error and needs the cell to revert back to it's original formatting. I have other macros running in this sheet that will alter the format based on the font being used. So this one would correct that if and when necessary. It needs to function for all of those cells, but only when needed in a particular cell (in this case original formatting for the DTP column reverts back to Wingdings, bold, 18pt black, where the QC column reverts back to Wingdings, bold, 18pt, green).

 

[rlv01]

and it came back with the following error:

That error means it cannot find the worksheet named "DTP Audit Checklist". However in your first post, you posted code

Sheets("DTP Audit Checklist").Select

that indicated "DTP Audit Checklist" was the name of your worksheet with the cells you want to format. This might happen if you have changed the name of your worksheet or tried run the code in a different workbook, one that did not have sheet "DTP Audit Checklist".

 

[rlv01]

It is reformatting all of those cells at once

Which was my understanding of your original post.

I only need it to reformat a cell if the user uses another macro in error and needs the cell to revert back to it's original formatting

If the macro is not to reformat all the cells at once, how is the macro to know which cell(s) needs reformatting?

 

[TWienholz]

Which was my understanding of your original post.



If the macro is not to reformat all the cells at once, how is the macro to know which cell(s) needs reformatting?

So initially when I set this up, I created the macro to unprotect the sheet, copy the style of the cells above the cells I was in (e.g. c22 and g22), apply the style to the cells and then reprotect the sheet, which worked, but ONLY in cells c22 and g22. If i went down to say c54 and g54 and tried to run it, it bounced me back up to c22 and g22. so i wasn't sure if there was a way to get it to work so that it worked but only on 2 cells at a time as opposed to clearing all 4 of those columns where other cells could be affected that may need to retain their information. Does that make sense?

 

[rlv01]

Try this.

Sub ReformatCell()
    '
    ' ReformatCell Macro
    ' This macro reformats a cell to its original formatting
    '
    ' Keyboard Shortcut: Ctrl+y
    '
    
    Dim WS As Worksheet
    Dim rngSourceFormat As Range
    Dim rngDestFormat As Range
    Dim rngCheckBoxes As Range
    Dim ColStr As String
    
    On Error Resume Next
    Set WS = Sheets("DTP Audit Checklist")
    On Error GoTo 0
    
    If WS Is Nothing Then
        MsgBox "Error - Cannot locate required worksheet '" & ActiveWorkbook.Name & "'", vbOKOnly Or vbCritical, ActiveWorkbook.Name
        Exit Sub
    End If
    
    WS.Activate

    Set rngCheckBoxes = Application.Union(WS.Range("C20:D84"), WS.Range("AG20:AG91"), WS.Range("AI20:AI91"))
    
    If Application.Intersect(ActiveCell, rngCheckBoxes) Is Nothing Then
        MsgBox "The cell you have selected for reformatting (" & ActiveCell.Address & ") is not a DTP or QC cell. Please try again. ", vbOKOnly Or vbCritical, Application.Name
        Exit Sub
    End If
    
    WS.Unprotect
    ColStr = Split(ActiveCell.Address, "$")(1)
    
    Select Case ColStr
        Case "C"
            Set rngDestFormat = ActiveCell.Resize(1, 2)
        Case "D"
            Set rngDestFormat = ActiveCell.Offset(0, -1).Resize(1, 2)
        Case "AG"
            Set rngDestFormat = ActiveCell.Resize(1, 3)
        Case "AI"
            Set rngDestFormat = ActiveCell.Offset(0, -2).Resize(1, 3)
    End Select
    
    Select Case rngDestFormat.Row
        Case Is = rngCheckBoxes.Cells(1, 1).Row
            Set rngSourceFormat = rngDestFormat.Offset(1)
        Case Else
            Set rngSourceFormat = rngDestFormat.Offset(-1)
    End Select
    
    rngSourceFormat.Copy
    rngDestFormat.PasteSpecial Paste:=xlPasteFormats
    rngDestFormat.ClearContents    'optional
    
    Application.CutCopyMode = False
    WS.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
End Sub