Macro help needed...

  • Thread starter Thread starter Dan E
  • Start date Start date
D

Dan E

New to VBA, I'm struggling to do the following in a worksheet:-
For all the cells in the sheet;
Begin. If the cell.interior.colorindex is 1 (black) or 15 (light grey),
do nothing except move on to the next cell and go back to Begin.
If the cell value has anything other than 2 or 3 characters or letters,
do nothing except move on to the next cell and go back to Begin.
Otherwise, using Select Case, set the background color to an index
linked to a particular string in the value, except that if the 2-or-3
character value is not found in the case list, do not change the background
color.
Repeat until all the cells have been checked, then end.

I already have the Case part (except for the "do not change the background
color" bit), thanks to Gord Dibben. Any help very much appreciated...
TIA
Dan
 
For Each cell In Selection
If cell.Interior.Colorindex = 1 Or _
cell.Interior.Colorindex = 15 Then
ElseIf Len(cell.Value) =2 Or Len(cell.Value) = 3 Then
Else
Select Case cell.Value
... Gord's bit
Case Else ; 'do nothing
End Select
End If
Next cell

--

HTH

RP
(remove nothere from the email address if mailing direct)
 
Many many thanks, Bob. Here's a real newbie question - is there a way to
specify a rectangular array of cells as the Selection? Also, it appears
that the sheet has to be unprotected before a macro will run. Is there any
trick to temporarily switch off protection, run the macro, then protect the
sheet again - and do it all automatically with a click or a keystroke
combination? Trying to protect my users....

Many thanks again.
Dan
 
Hi Dan,

Rectangular range.

There are (at least) 2 possibilities here. The first is to use the
currentregion

For Each cell In ActiveCell.CurrentRegion

which picks up the region of non-empty cells in the region around the
activecell, or Usedrange

For Each cell In Activesheet.UsedRange

which picks up a rectangular region of all non-empty cells. The latter is
probably better for your case.

You can switch protection off and on in code that you are building.

Activesheet.unProtect

and then

Activesheet.Protect

As a macro, you can add a button to a toolbar, and assign your macro to
that.

--

HTH

RP
(remove nothere from the email address if mailing direct)
 
VERY helpful, thank you, Bob. Incidentally, the code you posted for me in
"Re: Macro help needed" almost worked, but after it had correctly set the
color of a cell occupied by a recognized code in the Case part, it then
colored all following blank cells the same color, until it met another
recognized cell. Any suggestions? I'll post the code I was actually
using... Also, the VBA editor complained about the use of " Case Else ;
'do nothing", and I couldn't figure out how to make it legal... I'm
struggling with basics, I know.

Sub Color_Text()
Dim Cell As Range
Dim col As Integer
On Error GoTo ws_exit
For Each Cell In Selection
If Cell.Interior.ColorIndex = 1 Or Cell.Interior.ColorIndex = 15
Then
ElseIf Len(Cell.Value) = 2 Or Len(Cell.Value) = 3 Then
Select Case LCase(Cell.Value)
Case "um": col = 40
Case "rnm": col = 38
Case "mi": col = 35
Case "ml": col = 36
Case "mn": col = 37
Case "mq": col = 24
Case "m1": col = 35
Case "m2": col = 36
Case "m14": col = 38
Case "m4": col = 24
Case "m11": col = 43
Case "m7": col = 22
Case "m8": col = 20
Case "m16": col = 19
Case "m17": col = 27
Case "m15": col = 45
Case Else: col = 0
End Select
End If
Cell.Interior.ColorIndex = col
Next
ws_exit:
End Sub

Dan
 
Dan,

Your code for setting the colour should be within the Select End Select, not
after

Sub Color_Text()
Dim Cell As Range
Dim col As Integer
On Error GoTo ws_next
For Each Cell In ActiveSheet.UsedRange
If Cell.Interior.ColorIndex = 1 Or _
Cell.Interior.ColorIndex = 15 Then
ElseIf Len(Cell.Value) = 2 Or Len(Cell.Value) = 3 Then
Select Case LCase(Cell.Value)
Case "um": col = 40
Case "rnm": col = 38
Case "mi": col = 35
Case "ml": col = 36
Case "mn": col = 37
Case "mq": col = 24
Case "m1": col = 35
Case "m2": col = 36
Case "m14": col = 38
Case "m4": col = 24
Case "m11": col = 43
Case "m7": col = 22
Case "m8": col = 20
Case "m16": col = 19
Case "m17": col = 27
Case "m15": col = 45
Case Else: col = Cell.Interior.ColorIndex
End Select
Cell.Interior.ColorIndex = col
End If
ws_next:
Next
ws_exit:
End Sub

The Case Else; 'do nothing was a typo from me, it should have been colon
--

HTH

RP
(remove nothere from the email address if mailing direct)
 
Many thanks, Bob - worked beautifully. Now to try to understand WHY it
worked :-), then automate the process.

Thanks again,

Dan
 
Back
Top