Macro help needed...

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
 
B

Bob Phillips

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)
 
D

Dan E

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
 
B

Bob Phillips

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)
 
D

Dan E

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
 
B

Bob Phillips

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)
 
D

Dan E

Many thanks, Bob - worked beautifully. Now to try to understand WHY it
worked :), then automate the process.

Thanks again,

Dan
 
Top