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: 14

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
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
324
Micron
M
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
600
RoryA
RoryA
P
  • Question Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
379
6StringJazzer
6StringJazzer
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
1K
kerm007
K
R
  • Question Question
VBA - AUTO FIT, Can we remove make the sum formula in below code
Replies
1
Views
162
Joe4
Joe4

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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