Case "this" or "that" or "another&q

BMD

Board Regular
Joined
Oct 5, 2005
Messages
211
My case statement is just ‘Case "Major"’ but I have too many of them and most of the sub code is all the same. How can I say ‘Case "this" or "that" or "another”’ For:

Case "Pass"
If Cells(cell.Row, "M") = "Major" Or Cells(cell.Row, "M") = "Minor" Or Cells(cell.Row, "M") = "major" Or Cells(cell.Row, "M") = "minor" Then
.ColorIndex = 33
.Bold = True
Else
.ColorIndex = 10
.Bold = False
End If

Case "pass"
If Cells(cell.Row, "M") = "Major" Or Cells(cell.Row, "M") = "Minor" Or Cells(cell.Row, "M") = "major" Or Cells(cell.Row, "M") = "minor" Then
.ColorIndex = 33
.Bold = True
Else
.ColorIndex = 10
.Bold = False
End If
Case "Major"
If Cells(cell.Row, "G") = "Pass" Or Cells(cell.Row, "G") = "pass" Then
.ColorIndex = 33
.Bold = True
Else
.ColorIndex = 10
.Bold = False
End If

Case "Fail"
.ColorIndex = 3
.Bold = False
Case "fail"
.ColorIndex = 3
.Bold = False
Case ""
.ColorIndex = 1
.Bold = False
Case " "
.ColorIndex = 1
.Bold = False
Case Else
.ColorIndex = 1
.Bold = False
 

tusharm

MrExcel MVP
Joined
May 28, 2002
Messages
11,007
If you check XL VBA help for the Select Case statement, it contains examples of how to code a Case choice for multiple selections. One example is
Case "everything", "nuts" To "soup", TestItem

In addition, instead of testing for Major and major you can use UCase to test for just MAJOR. Similarly, instead of dealing with "" and " ", use TRIM() to eliminate leading and trailing spaces.
Code:
Select Case UCase(Trim(aCell.value))
Case "MAJOR","MINOR":
Case "":
Case Else:
    End Select
 

ChrisM

Well-known Member
Joined
Jun 11, 2002
Messages
2,128
You can use Select Case LCase(yourstr) to get rid of the upper case and lower case tests.

Your last three tests, "", " ", and Case Else all result in the same output, colorindex = 1, so get rid of the case "" and case " " and just leave the case else.
 

BMD

Board Regular
Joined
Oct 5, 2005
Messages
211
Thank you,
tusharm

Thank you,
ChrisM
I removed the redundant case “” at the end, but I could not get ‘Select Case LCase(cell)’ to work, nothing changed.

For Each cell In rng
With Range(Cells(cell.Row, "A"), Cells(cell.Row, "O")).Font
Select Case LCase(cell)
Case "Pass", "pass", "P", "p"
If Cells(cell.Row, "M") = "Major" Or Cells(cell.Row, "M") = "Minor" Or Cells(cell.Row, "M") = "major" Or Cells(cell.Row, "M") = "minor" Then
.ColorIndex = 33
.Bold = True
Else
.ColorIndex = 10
.Bold = False
End If
 

ChrisM

Well-known Member
Joined
Jun 11, 2002
Messages
2,128
Hmm, not sure why Lcase doesn't work for you. Here's my code that works:

Code:
Private Sub CommandButton1_Click()

Dim rng As Range
Dim cell As Range

Set rng = Sheet1.Range(Cells(19, 8), Cells(22, 8))

For Each cell In rng
    Select Case LCase(cell)
        Case "yo"
            MsgBox "yay"
        Case Else
            MsgBox "booh"
    End Select
Next cell

End Sub
 

BMD

Board Regular
Joined
Oct 5, 2005
Messages
211
THANKS,
Chris M.

I'm on Version 9969 VBA: Retail 6.4.8869 Forms3: 2.01

Oh well, This does not work even if I use input "Pass" the only true match.

One more thing, can I just cut this from sheet 1 and paste it in Thisworkbook and have it functional on all 19 sheets?


Private Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim cell As Range
Dim rng As Range

Set WatchRange = Columns("G")
Set WatchRangeM = Columns("M")
Dim myMultiAreaRange As Range
Set myMultiAreaRange = Union(WatchRange, WatchRangeM)

If Intersect(Target, myMultiAreaRange) Is Nothing Then Exit Sub
Set rng = Intersect(Target, myMultiAreaRange)

For Each cell In rng
With Range(Cells(cell.Row, "A"), Cells(cell.Row, "O")).Font
Select Case LCase(cell)
Case "Pass" ', "pass", "P", "p"
If Cells(cell.Row, "M") = "Major" Or Cells(cell.Row, "M") = "Minor" Or Cells(cell.Row, "M") = "major" Or Cells(cell.Row, "M") = "minor" Then
.ColorIndex = 33
.Bold = True
Else
.ColorIndex = 10
.Bold = False
End If
Case "Major" ', "Maj", "Minor", "Min"
If Cells(cell.Row, "G") = "Pass" Or Cells(cell.Row, "G") = "P" Or Cells(cell.Row, "G") = "pass" Or Cells(cell.Row, "G") = "p" Then
.ColorIndex = 33
.Bold = True
Else
.ColorIndex = 10
.Bold = False
End If
Case "Fail", "F", "fail", "f"
.ColorIndex = 3
.Bold = False
Case Else
.ColorIndex = 1
.Bold = False
End Select
End With
Next cell
End Sub
 

Nimrod

MrExcel MVP
Joined
Apr 29, 2002
Messages
6,259
BMD:

To make comparisons consider upper and lower case letters the same you just need to include one statement at the VERY TOP of the module. The Statement to include is Option Compare Text

This statement , when placed at the very top of the module, will make all comparisons in that module, regard upper and lower as the same.

EXAMPLE ...

Code:
Option Compare Text

Public Sub demo()
Letter = "P"

If Letter = "p" Then MsgBox "Case does not matter"
End Sub
 

ChrisM

Well-known Member
Joined
Jun 11, 2002
Messages
2,128
You can't copy that code directly into the workbook module, but you're on the right track.

To figure this out on your own in the future, remember you're dealing with objects. Right now your code is acting on the worksheet object. If you want to work with all sheets at once, then logically you need to look at the workbook object. Open up the help file, and do a search for workbook, click around until you find a link for the workbook object. Every object has properties, methods, and most have events. Methods and events are actions, like sheet changes. In this case, click events and look for something dealing with sheet changes.

You'll find what you want under SheetChange Event.

From the helpfile:

This example runs when any worksheet is changed.
Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, _
        ByVal Source As Range)
    ' runs when a sheet is changed
End Sub
Basically, you keep your same code but now you have to deal with a sheet object. Test Sh against your 19 sheet names. If it's one of your 19, then execute your code. If there are only 19 sheets in your workbook, you can skip the test.
 

Forum statistics

Threads
1,078,373
Messages
5,339,814
Members
399,328
Latest member
Jasonabelly

Some videos you may like

This Week's Hot Topics

Top