1) macro to toggle cell border and 2) macro to toggle cell color fill

P

pabloevan

New Member
Joined
Sep 15, 2018
Messages
15
Hey guys,

I've been racking my brain trying come up with 2 separate macros:

macro 1) toggle cell border between borders: top, bottom, left, right, outside, top and double bottom, none
macro 2) toggle cell interior color between: yellow, light gray, light blue, no fill

I tried using the "case" function in vba but can't get it to work.

Any help is appreciated.

Thanks,
Paul
 
Sort by date Sort by votes
I tried to apply this to toggle the borders but I’m failing.


Here is the general structure I used:



With ActiveCell.Borders
Select CaseActiveCell.Borders
Case xlNone
.Borders = xlEdgeTop
CasexlEdgeTop

.Borders = xlEdgeBottom
CasexlEdgeBottom
.Borders = xlEdgeLeft
CasexlEdgeLeft
.Borders = xlEdgeRight
CasexlEdgeRight
.Borders = [NOT SURE HOW TO INPUT “OUTSIDE BORDER”]

Case [OUTSIDEBORDER]
.Borders = [NOT SURE HOW TO INPUT ‘TOP AND DOUBLE BOTTOM BORDER”]
Case [TOPAND DOUBLE BOTTOM BORDER]
.Borders = xlNone
End Select
End With

 
Upvote 0

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
pabloevan said:
I works perfectly! Thanks! I assume the border toggle uses a similar structure. Where I messed up was with the usage of the "with" and "select" language.
Click to expand...

I'm failing trying to do this with my borders. It seems I'm missing a parameter?

Here is the general structure I used:

With ActiveCell.Borders
Select CaseActiveCell.Borders
CasexlNone
.Borders = xlEdgeTop
Case xlEdgeTop
.Borders = xlEdgeBottom
Case xlEdgeBottom
.Borders = xlEdgeLeft
Case xlEdgeLeft
.Borders = xlEdgeRight
Case xlEdgeRight
.Borders = [NOT SURE HOW TO INPUT “OUTSIDE BORDER”]
Case [OUTSIDE BORDER]
.Borders = [NOT SURE HOW TO INPUT ‘TOP AND DOUBLE BOTTOM BORDER”]
Case [TOP AND DOUBLE BOTTOM BORDER]
.Borders = xlNone
End Select
End With
 
Upvote 0
pabloevan said:
I'm failing trying to do this with my borders.
Click to expand...
Since you are only doing this for the active cell, the only borders are the top, bottom and two sides. Give this macro a try...
Code: 
[table="width: 500"]
[tr]
	[td]Sub ToggleBorders()
  With ActiveCell
    .Borders(xlEdgeTop).LineStyle = xlContinuous + xlLineStyleNone - .Borders(xlEdgeTop).LineStyle
    .Borders(xlEdgeLeft).LineStyle = xlContinuous + xlLineStyleNone - .Borders(xlEdgeLeft).LineStyle
    .Borders(xlEdgeRight).LineStyle = xlContinuous + xlLineStyleNone - .Borders(xlEdgeRight).LineStyle
    .Borders(xlEdgeBottom).LineStyle = xlDouble + xlLineStyleNone - .Borders(xlEdgeBottom).LineStyle
  End With
End Sub[/td]
[/tr]
[/table]
By the way, in case you missed the one liner macro that I posted earlier for toggling the colors, here it is again (modified to do the active cell)...
Code: 
Sub MyNonCase()
  ActiveCell.Interior.ColorIndex = Evaluate("LOOKUP(" & ActiveCell.Interior.ColorIndex & ",{-4142,6,15,17},{6,15,17,-4142})")
End Sub
 
Upvote 0
Rick Rothstein said:
Since you are only doing this for the active cell, the only borders are the top, bottom and two sides. Give this macro a try...
Code: 
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub ToggleBorders()
  With ActiveCell
    .Borders(xlEdgeTop).LineStyle = xlContinuous + xlLineStyleNone - .Borders(xlEdgeTop).LineStyle
    .Borders(xlEdgeLeft).LineStyle = xlContinuous + xlLineStyleNone - .Borders(xlEdgeLeft).LineStyle
    .Borders(xlEdgeRight).LineStyle = xlContinuous + xlLineStyleNone - .Borders(xlEdgeRight).LineStyle
    .Borders(xlEdgeBottom).LineStyle = xlDouble + xlLineStyleNone - .Borders(xlEdgeBottom).LineStyle
  End With
End Sub[/TD]
[/TR]
</tbody>[/TABLE]
By the way, in case you missed the one liner macro that I posted earlier for toggling the colors, here it is again (modified to do the active cell)...
Code: 
Sub MyNonCase()
  ActiveCell.Interior.ColorIndex = Evaluate("LOOKUP(" & ActiveCell.Interior.ColorIndex & ",{-4142,6,15,17},{6,15,17,-4142})")
End Sub
Click to expand...

Thanks for the reply. On the color one, one of the other posters suggested something that worked so I figured no need to recreate the wheel. I'll take note of the technique you used to toggle the colors for future needs.

here is what I did on the toggle color. This allowed me to highlight multiple cells, row, column or a single cell and toggle the cell color

Sub cellfill()
'
' cellfill Macro
'
' Keyboard Shortcut: Ctrl+s
'
With ActiveCell.Interior
Select Case ActiveCell.Interior.ColorIndex
Case 6 'Yellow
Selection.Interior.ColorIndex = 15 'Light Gray
Case 15 'Light Gray
Selection.Interior.ColorIndex = 34 'Light Blue
Case 34 'Light Blue
Selection.Interior.ColorIndex = -4142 'No color
Case -4142 'No color
Selection.Interior.ColorIndex = 6 'Yellow
End Select
End With
End Sub
 
Upvote 0
I plugged in the toggle border macro you suggested.
When I test it, it only does 2 toggles:
a - all four at the same time (top, left, right, and for some reason double bottom?)
b - no border
 
Upvote 0
I'd like to have 7 border toggles when applied to active cell, highlighted cluster of cells, row, or column:
1. top
2. left
3. right
4. bottom
5. outside
6. top and double bottom
7. none
repeat the sequence
 
Upvote 0
pabloevan said:
I plugged in the toggle border macro you suggested.
When I test it, it only does 2 toggles:
a - all four at the same time (top, left, right, and for some reason double bottom?)
b - no border
Click to expand...

oh wait I see the "double" language in your macro. that explains the double bottom
 
Upvote 0
pabloevan said:
I'd like to have 7 border toggles when applied to active cell, highlighted cluster of cells, row, or column:
1. top
2. left
3. right
4. bottom
5. outside
6. top and double bottom
7. none
repeat the sequence
Click to expand...
Ahh, I misunderstood your request with my previous code. Give this macro a try...
Code: 
[table="width: 500"]
[tr]
	[td]Sub ToggleBorders()
  Dim CurBorder As Long, Brdr As String, B As Variant
  With ActiveCell
    For Each B In Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
      If Not .Borders(B).LineStyle = xlLineStyleNone Then Brdr = Trim(Brdr & " " & B)
    Next
    If Len(Brdr) = 0 Then
      .Borders(xlEdgeTop).LineStyle = xlContinuous
    ElseIf InStr(Brdr, " ") = 0 Then
      .Borders(Brdr).LineStyle = xlLineStyleNone
      Select Case Brdr
        Case xlEdgeTop
          .Borders(xlEdgeLeft).LineStyle = xlContinuous
        Case xlEdgeLeft
          .Borders(xlEdgeRight).LineStyle = xlContinuous
        Case xlEdgeRight
          .Borders(xlEdgeBottom).LineStyle = xlContinuous
        Case xlEdgeBottom
          .BorderAround xlContinuous
      End Select
    ElseIf Brdr Like "* * * *" Then
      .Borders(xlEdgeTop).LineStyle = xlContinuous
      .Borders(xlEdgeLeft).LineStyle = xlLineStyleNone
      .Borders(xlEdgeRight).LineStyle = xlLineStyleNone
      .Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
      .Borders(xlEdgeBottom).LineStyle = xlDouble
    Else
      .Borders(xlEdgeTop).LineStyle = xlLineStyleNone
      .Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
    End If
  End With
End Sub[/td]
[/tr]
[/table]
 
Upvote 0
Rick Rothstein said:
Ahh, I misunderstood your request with my previous code. Give this macro a try...
Code: 
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub ToggleBorders()
  Dim CurBorder As Long, Brdr As String, B As Variant
  With ActiveCell
    For Each B In Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
      If Not .Borders(B).LineStyle = xlLineStyleNone Then Brdr = Trim(Brdr & " " & B)
    Next
    If Len(Brdr) = 0 Then
      .Borders(xlEdgeTop).LineStyle = xlContinuous
    ElseIf InStr(Brdr, " ") = 0 Then
      .Borders(Brdr).LineStyle = xlLineStyleNone
      Select Case Brdr
        Case xlEdgeTop
          .Borders(xlEdgeLeft).LineStyle = xlContinuous
        Case xlEdgeLeft
          .Borders(xlEdgeRight).LineStyle = xlContinuous
        Case xlEdgeRight
          .Borders(xlEdgeBottom).LineStyle = xlContinuous
        Case xlEdgeBottom
          .BorderAround xlContinuous
      End Select
    ElseIf Brdr Like "* * * *" Then
      .Borders(xlEdgeTop).LineStyle = xlContinuous
      .Borders(xlEdgeLeft).LineStyle = xlLineStyleNone
      .Borders(xlEdgeRight).LineStyle = xlLineStyleNone
      .Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
      .Borders(xlEdgeBottom).LineStyle = xlDouble
    Else
      .Borders(xlEdgeTop).LineStyle = xlLineStyleNone
      .Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
    End If
  End With
End Sub[/TD]
[/TR]
</tbody>[/TABLE]
Click to expand...


Works perfectly! This forum is the best thing ever. I spent a long time trying this on my own before discovering this community. Thanks to everybody that helped out
 
Upvote 0
pabloevan said:
Works perfectly! This forum is the best thing ever. I spent a long time trying this on my own before discovering this community. Thanks to everybody that helped out
Click to expand...


I'm trying to tweak that macro now to allow me to apply this same border toggle to an active cell, highlighted cluster of cells, row, or column. I know that i need to insert some "selection" language in there but can't seem to get the right combination. It works well for the first 3 options in the toggle: top, left, and right. Once I get to bottom, however, it gets all messed up

here is what I have below. Please let me know where I went wrong

Dim CurBorder As Long, Brdr As String, B As Variant
With ActiveCell
For Each B In Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
If Not .Borders(B).LineStyle = xlLineStyleNone Then Brdr = Trim(Brdr & " " & B)
Next
If Len(Brdr) = 0 Then
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
ElseIf InStr(Brdr, " ") = 0 Then
Selection.Borders(Brdr).LineStyle = xlLineStyleNone
Select Case Brdr
Case xlEdgeTop
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Case xlEdgeLeft
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Case xlEdgeRight
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Case xlEdgeBottom
Selection.BorderAround xlContinuous
End Select
ElseIf Brdr Like "* * * *" Then
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).LineStyle = xlLineStyleNone
Selection.Borders(xlEdgeRight).LineStyle = xlLineStyleNone
Selection.Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
Selection.Borders(xlEdgeBottom).LineStyle = xlDouble
Else
Selection.Borders(xlEdgeTop).LineStyle = xlLineStyleNone
Selection.Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
End If
End With
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question Question
Help writing macros to toggle through various formatting (font color, cell fill color, number format, decimals, borders)
Replies
1
Views
801
jolivanes
jolivanes
L
  • Question Question
VBA to change cell color based on existing cell color
Replies
9
Views
1K
Joe4
Joe4
C
  • Solved
VBA Fill rows with color, but skip cells with already certain color fills
Replies
5
Views
3K
Zot
Z
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
1K
AndyEd
A
M
  • Solved
Fill cell color without deleting conditional formatting
Replies
1
Views
910
Fluff
Fluff

Forum statistics

Threads
1,223,911
Messages
6,175,323
Members
452,635
Latest member
laura12345

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