View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Bob Phillips[_6_] Bob Phillips[_6_] is offline
external usenet poster
 
Posts: 11,272
Default color hidden columns

Here you are Barabra, as requested, although I am at a loss as to know what
use it is to colour hidden columns? Also, be aware that there are a lot more
rows than columns, so by colouring a whole column, you are in creasing the
size of a workbook far more than by colouring a row.

Sub ColourHiddenColumns()
On Error GoTo Terminator
Dim cw As Range
Dim fstcw As Range
Dim myRange As Range
Dim myColor As Long
Dim myPattern As Long
Dim myPatternColor As Long
For Each cw In ActiveSheet.UsedRange.Columns
If cw.Hidden = True Then
If fstcw Is Nothing Then
Set fstcw = cw
Exit For
End If
End If
Next
fstcw.Select
Application.Dialogs(xlDialogPatterns).Show
myColor = ActiveCell.Interior.ColorIndex
myPattern = ActiveCell.Interior.Pattern
myPatternColor = ActiveCell.Interior.PatternColorIndex
For Each cw In ActiveSheet.UsedRange.Columns
If cw.Hidden = True Then
With cw.EntireColumn.Interior
.ColorIndex = myColor
.Pattern = myPattern
.PatternColorIndex = myPatternColor
End With
End If
Next
Exit Sub
Terminator: MsgBox "There are no hidden columns ", vbExclamation
End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Barbara Wiseman" wrote in message
...
Sorry for the newbie (in programming anyway) question.

I have found a great macro for colouring hidden rows from Andrew Engwirda
which I have copied below. Could some kind programming guru help me
transform it in to a macro to colour hidden columns.
Thanks in advance,
Barbara
(from my spelling of colour, you may guess I am from the UK)

http://blog.livedoor.jp/andrewe/archives/13105945.html

Sub ColorHiddenRows()
On Error GoTo Terminator
Dim rw As Range
Dim fstrw As Range
Dim myRange As Range
Dim myColor As Long
Dim myPattern As Long
Dim myPatternColor As Long
Set myRange = Selection
For Each rw In myRange.Rows
If rw.Hidden = True Then
If fstrw Is Nothing Then
Set fstrw = rw
Exit For
End If
End If
Next
fstrw.Select
Application.Dialogs(xlDialogPatterns).Show
myColor = ActiveCell.Interior.ColorIndex
myPattern = ActiveCell.Interior.Pattern
myPatternColor = ActiveCell.Interior.PatternColorIndex
For Each rw In myRange.Rows
If rw.Hidden = True Then
rw.Interior.ColorIndex = myColor
rw.Interior.Pattern = myPattern
rw.Interior.PatternColorIndex = myPatternColor
End If
Next
Exit Sub
Terminator: MsgBox "There are no hidden rows ", vbExclamation
End Sub