VBA Format Toggle

I

irie267

New Member
Joined
Jul 1, 2012
Messages
25
Office Version
  1. 2016
Platform
  1. Windows
Hello All--

I am having an issue with this VBA code (please keep in mind I am a novice). When the VBA is activated on a standard cell (or a range of cells), I would like it to go to a dots format, and then a double diagonal format, and then back to the original standard format. However, when I activate the VBA I am getting a combination/cumulative result of dots and diagonal lines at the same time. It is working correctly when an individual cell is selected, however, when a range of cells the macro is incorrectly formatting. I've included a gif to show what I mean. Any help would be appreciated, thank you in advance.

The code is below:
VBA Code: 
Sub Blank_Format()
'
' Blank Format Macro
'
' Keyboard Shortcut: Ctrl+Shift+Q
'
Application.ScreenUpdating = False

Dim cell As Range

    For Each cell In Selection
 
    On Error GoTo Error
 
        '\\Dots format
        If cell.Interior.Color = "16777215" And cell.Interior.Pattern = "-4142" Then
            cell.Interior.Pattern = 18
            cell.Font.Color = "0"
            cell.Interior.Color = "16777215"
            cell.Font.Bold = False
 
            With Selection.Interior
                .Pattern = xlGray8
                .PatternThemeColor = xlThemeColorLight1
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                .PatternTintAndShade = 0
             
            End With
     
        '\\Slash format
        ElseIf cell.Interior.Pattern = 18 Then
     
            cell.Interior.Pattern = xlSolid
            With Selection.Borders(xlDiagonalUp)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(192, 192, 192)
                End With
         
            With Selection.Borders(xlDiagonalDown)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(192, 192, 192)
             
            End With
         
        Else
        '\\Base format
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            cell.Interior.Pattern = xlSolid
            cell.Font.Color = "0"
            cell.Interior.Color = "16777215"
            cell.Font.Bold = False
            cell.Interior.ColorIndex = "0"

        End If
    
Error:
    
        If Err.Description <> "" Then
            cell.Interior.Pattern = xlSolid
            cell.Font.Color = "0"
            cell.Interior.Color = "16777215"
            cell.Font.Bold = False
            cell.Interior.ColorIndex = "0"
        End If
 
    Next cell

Application.ScreenUpdating = True

End Sub
 

Attachments

  • Recording 2023-05-11 at 23.13.52.gif
    Recording 2023-05-11 at 23.13.52.gif
    226.7 KB · Views: 12

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sort by date Sort by votes
There are 5 places in your loop that refer to Selection. Replace 'Selection' with 'cell'

Also, under '\\Slash format, some code is repeated.
 
Last edited:
Upvote 0
footoo said:
There are 5 places in your loop that refer to Selection. Replace 'Selection' with 'cell'

Also, under '\\Slash format, some code is repeated.
Click to expand...
Thank you--I am still in the learning phase, so I appreciate your patience.
 
Upvote 0
footoo said:
There are 5 places in your loop that refer to Selection. Replace 'Selection' with 'cell'

Also, under '\\Slash format, some code is repeated.
Click to expand...
Is there a way to make these formats "layer" on top of the existing cell color? For example, if the cell is yellow, this macro currently just replaces it with white and adds dots and then slashes--is there a way to not change the background color, but just to layer the dots and slashes on top of whatever color the cell is?
 
Upvote 0
Try this :
VBA Code: 
Sub Blank_Format()
' Keyboard Shortcut: Ctrl+Shift+Q
Dim cel As Range, x%
Application.ScreenUpdating = False
For Each cel In Selection
    With cel
        x = .Interior.ColorIndex
        On Error GoTo Error
        If .Borders(xlDiagonalUp).LineStyle = xlContinuous Then
            '\\Base format
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Font.Color = 0
            .Font.Bold = False
            .Interior.Pattern = xlNone
            .Interior.ColorIndex = x
        ElseIf .Interior.Pattern = 18 Then
            '\\Slash format
            .Interior.Pattern = xlNone
            .Interior.ColorIndex = x
            With .Borders(xlDiagonalUp)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(192, 192, 192)
            End With
        Else
            '\\Dots format
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Font.Color = 0
            .Font.Bold = False
            With .Interior
                .ColorIndex = x
                .Pattern = 18
            End With
        End If
Error:
        If Err <> 0 Then
            .Font.Color = 0
            .Font.Bold = False
            .Interior.Pattern = xlNone
            .Interior.ColorIndex = x
        End If
    End With
Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0
footoo said:
Try this :
VBA Code: 
Sub Blank_Format()
' Keyboard Shortcut: Ctrl+Shift+Q
Dim cel As Range, x%
Application.ScreenUpdating = False
For Each cel In Selection
    With cel
        x = .Interior.ColorIndex
        On Error GoTo Error
        If .Borders(xlDiagonalUp).LineStyle = xlContinuous Then
            '\\Base format
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Font.Color = 0
            .Font.Bold = False
            .Interior.Pattern = xlNone
            .Interior.ColorIndex = x
        ElseIf .Interior.Pattern = 18 Then
            '\\Slash format
            .Interior.Pattern = xlNone
            .Interior.ColorIndex = x
            With .Borders(xlDiagonalUp)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(192, 192, 192)
            End With
        Else
            '\\Dots format
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Font.Color = 0
            .Font.Bold = False
            With .Interior
                .ColorIndex = x
                .Pattern = 18
            End With
        End If
Error:
        If Err <> 0 Then
            .Font.Color = 0
            .Font.Bold = False
            .Interior.Pattern = xlNone
            .Interior.ColorIndex = x
        End If
    End With
Next
Application.ScreenUpdating = True
End Sub
Click to expand...
Thank you this is working, with one minor exception--it is not making an "x" in the cell with both diagonal up and diagonal down formatting, it is making only diagonal up:


1684588362381.png
 
Upvote 0
I forgot diagonal down :
VBA Code: 
Sub Blank_Format()
' Keyboard Shortcut: Ctrl+Shift+Q
Dim cel As Range, x%
Application.ScreenUpdating = False
For Each cel In Selection
    With cel
        x = .Interior.ColorIndex
        On Error GoTo Error
        If .Borders(xlDiagonalUp).LineStyle = xlContinuous Then
            '\\Base format
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Font.Color = 0
            .Font.Bold = False
            .Interior.Pattern = xlNone
            .Interior.ColorIndex = x
        ElseIf .Interior.Pattern = 18 Then
            '\\Slash format
            .Interior.Pattern = xlNone
            .Interior.ColorIndex = x
            With .Borders(xlDiagonalUp)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(192, 192, 192)
            End With
             With .Borders(xlDiagonalDown)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(192, 192, 192)
            End With
       Else
            '\\Dots format
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Font.Color = 0
            .Font.Bold = False
            With .Interior
                .ColorIndex = x
                .Pattern = 18
            End With
        End If
Error:
        If Err <> 0 Then
            .Font.Color = 0
            .Font.Bold = False
            .Interior.Pattern = xlNone
            .Interior.ColorIndex = x
        End If
    End With
Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0
footoo said:
I forgot diagonal down :
VBA Code: 
Sub Blank_Format()
' Keyboard Shortcut: Ctrl+Shift+Q
Dim cel As Range, x%
Application.ScreenUpdating = False
For Each cel In Selection
    With cel
        x = .Interior.ColorIndex
        On Error GoTo Error
        If .Borders(xlDiagonalUp).LineStyle = xlContinuous Then
            '\\Base format
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Font.Color = 0
            .Font.Bold = False
            .Interior.Pattern = xlNone
            .Interior.ColorIndex = x
        ElseIf .Interior.Pattern = 18 Then
            '\\Slash format
            .Interior.Pattern = xlNone
            .Interior.ColorIndex = x
            With .Borders(xlDiagonalUp)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(192, 192, 192)
            End With
             With .Borders(xlDiagonalDown)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(192, 192, 192)
            End With
       Else
            '\\Dots format
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Font.Color = 0
            .Font.Bold = False
            With .Interior
                .ColorIndex = x
                .Pattern = 18
            End With
        End If
Error:
        If Err <> 0 Then
            .Font.Color = 0
            .Font.Bold = False
            .Interior.Pattern = xlNone
            .Interior.ColorIndex = x
        End If
    End With
Next
Application.ScreenUpdating = True
End Sub
Click to expand...
Thank you so much.
 
Upvote 0
Additional follow up question--do you know why when this macro is activated it is making the underlying color of the cell a little bit lighter? Ive tested it and by using this macro it slightly changes the underlying color (see below). You'll notice that the yellow in the "x" cells in the financial assumptions section is slightly lighter than yellow in the waterfall assumptions section. They started as the same shade of yellow. Ive tested this on other colors as well and it does the same thing.

1685320241381.png


Any help would be appreciated.
 
Upvote 0
Try this :
VBA Code: 
Sub Blank_Format()
' Keyboard Shortcut: Ctrl+Shift+Q
Dim cel As Range, x&
Application.ScreenUpdating = False
For Each cel In Selection
    With cel
        x = .Interior.Color
        On Error GoTo Error
        If .Borders(xlDiagonalUp).LineStyle = xlContinuous Then
            '\\Base format
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Font.Color = 0
            .Font.Bold = False
            .Interior.Pattern = xlNone
            .Interior.Color = x
        ElseIf .Interior.Pattern = 18 Then
            '\\Slash format
            .Interior.Pattern = xlNone
            .Interior.Color = x
            With .Borders(xlDiagonalUp)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(192, 192, 192)
            End With
             With .Borders(xlDiagonalDown)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(192, 192, 192)
            End With
       Else
            '\\Dots format
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Font.Color = 0
            .Font.Bold = False
            With .Interior
                .Color = x
                .Pattern = 18
            End With
        End If
Error:
        If Err <> 0 Then
            .Font.Color = 0
            .Font.Bold = False
            .Interior.Pattern = xlNone
            .Interior.Color = x
        End If
    End With
Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

K
  • Solved
formating question
Replies
3
Views
89
Micron
M
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
350
RoryA
RoryA
P
  • Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
203
6StringJazzer
6StringJazzer
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
882
kerm007
K
J
  • Question
VBA Code to Add Rows is slowing down
Replies
5
Views
530
JayB0730
J

Forum statistics

Threads
1,215,363
Messages
6,124,505
Members
449,166
Latest member
hokjock

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top