View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default color hidden columns

Sub ColorHiddenColumns()
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.Columns
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.Columns
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

--
Regards,
Tom Ogilvy



"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