Excel VBA Select Case Loop Sub
In my excel file, I have a table setup with formulas.
with Cells from Range("B2:B12"), Range ("D2:D12"), and etc every other row containing the answers to these formulas.
for these cells (with the formula answers), I need to apply conditional formatting, but I have 7 conditions, so I've been using "select case" in VBA to change their interior background based on their number. I have the select case function currently set up within the sheet code, as opposed to it's own macro
Pr开发者_JAVA技巧ivate Sub Worksheet_Change(ByVal Target As Range)
Dim iColor As Integer
If Not Intersect(Target, Range("B2:L12")) Is Nothing Then
Select Case Target
Case 0
iColor = 2
Case 0.01 To 0.49
iColor = 36
Case 0.5 To 0.99
iColor = 6
Case 1 To 1.99
iColor = 44
Case 2 To 2.49
iColor = 45
Case 2.5 To 2.99
iColor = 46
Case 3 To 5
iColor = 3
End Select
Target.Interior.ColorIndex = iColor
End If
End Sub
but using this method, you must be actually entering the value into the cell for the formatting to work.
which is why I want to write a subroutine to to do this as a macro. I can input my data, let the formulas work, and when everything is ready, I can run the macro and format those specific cells.
I want an easy way to do this, obviously I could waste a load of time, typing out all the cases for every cell, but I figured it'd be easier with a loop.
how would I go about writing a select case loop to change the formatting on a a specific range of cells every other row?
thank you in advance.
Here is a very basic loop that goes through all cells in a range and sets the ColorIndex. (I did not try it but it should work)
Private Function getColor(ByVal cell As Range) As Integer
Select Case cell
Case 0
getColor = 2: Exit Function
Case 0.01 To 0.49
getColor = 36: Exit Function
Case 0.5 To 0.99
getColor = 6: Exit Function
Case 1 To 1.99
getColor = 44: Exit Function
Case 2 To 2.49
getColor = 45: Exit Function
Case 2.5 To 2.99
getColor = 46: Exit Function
Case 3 To 5
getColor = 3: Exit Function
End Select
End Function
Private Sub setColor()
Dim area As Range
Dim cell As Range
Set area = Range("B2:L12")
For Each cell In area.Cells
cell.Interior.ColorIndex = getColor(cell)
Next cell
End Sub
Edit: It works now. I forgot to add Interior infront of ColorIndex and set ByRef to ByVal. Btw. please add your comments as a comment to my answer.
Edit2: Regarding your Errormsg when changing the value:
"Ambiguous name detected: setColor"
I guess you still have some code left in your worksheet_change. You did not mention how you want to run your Sub.
If you want to run it on worksheet_change you just need to add the code in the worksheet in vba (not the module) and call setcolor. There can be only one setColor so make sure that it is either in your module or your worksheet.
If you want to run it from a module you need to change
Private Sub setColor()
to
Public Sub setColor()
And it would be better to add The worksheetname or ActiveSheet infront of your Range. Like this:
Set area = ActiveSheet.Range("B2:L12")
Option Explicit
Private Function getColor(cell As Range) As Integer
Select Case cell
Case 0
getColor = 2: Exit Function
Case 0.01 To 0.49
getColor = 36: Exit Function
Case 0.5 To 0.99
getColor = 6: Exit Function
Case 1 To 1.99
getColor = 44: Exit Function
Case 2 To 2.49
getColor = 45: Exit Function
Case 2.5 To 2.99
getColor = 46: Exit Function
Case 3 To 5
getColor = 3: Exit Function
End Select
End Function
Public Sub setColor()
Dim area As Range
Dim cell As Range
Set area = Range("B2:L12")
For Each cell In area.Cells
cell.Interior.ColorIndex = getColor(cell)
Next cell
End Sub
EDIT: Go ahead to accept @marg's answer.
I have merely used his code & corrected a few things, which caused compile time error.
精彩评论