开发者

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.

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜