3
\$\begingroup\$

i've written a procedure to where it selects the first and second highest values not already selected (as designated by previous highlights of green and yellow). The first highest ignores anything already highlighted in green or yellow and selects the highest value. The second highest value ignores anything highlighted in green or yellow AND ignores the first highest highlighted in red. It then designates each selection with a 1 for 1st highest and 2 for second highest. It works but the problem is... it takes 1 minute 30 seconds to run, which isn't ideal. Is there another way I can write this? Please see below and thank you.

Sub Macro1()
' Select highest value not already selected (as designated by highlights green and yellow)

Sheets("sheet1").Select
Dim rng As Range, s As Range
Set rng = Range("C2:D500000")
Set s = Range("C2")
For Each r In rng
If r.Value > s And r.EntireRow.Interior.ColorIndex <> 4 And r.EntireRow.Interior.ColorIndex <> 6 Then Set s = r
Next r
For Each r In rng
If s.Value = r.Value And r.EntireRow.Interior.ColorIndex <> 4 And r.EntireRow.Interior.ColorIndex <> 6 Then r.EntireRow.Interior.ColorIndex = 22
Next r

' Select second highest value not already selected (as designated by highlights green, yellow, and red, which is first highest)

Dim rng2 As Range, q As Range
Set rng2 = Range("C2:D500000")
Set q = Range("C2")
For Each r In rng2
If r.Value > q And r.EntireRow.Interior.ColorIndex <> 22 And r.EntireRow.Interior.ColorIndex <> 4 And r.EntireRow.Interior.ColorIndex <> 6 Then Set q = r
Next r
For Each r In rng2
If q.Value = r.Value And r.EntireRow.Interior.ColorIndex <> 22 And r.EntireRow.Interior.ColorIndex <> 4 And r.EntireRow.Interior.ColorIndex <> 6 _
Then r.EntireRow.Interior.ColorIndex = 20
Next r

'Designates 1st highest with the number 1

Dim rg As Range


Set rg = Range("V2:V500000")
For Each cell In rg
If cell.EntireRow.Interior.ColorIndex = 22 Then
cell.Offset(0, 1) = "1"
End If
Next


'Designates second highest with the number 2

Set rg3 = Range("V2:V500000")
For Each cell In rg3
If cell.EntireRow.Interior.ColorIndex = 20 Then
cell.Offset(0, 1) = "2"
End If
Next
End Sub
\$\endgroup\$
4
\$\begingroup\$

I've done my best to refactor your code in such a way that you can use it to learn to improve your coding, but also in such a way that it all makes sense. I'll post it and then explain the process and some tips.

The Code

Option Explicit
Sub HighlightHighestValueRows()
    ' Select highest value not already selected (as designated by highlights green and yellow)

    Dim TargetSheet As Worksheet

    ' Use an Explicit reference to the sheet you are operating on
    ' This will find the sheet named "Sheet1" within the workbook that the code is run in.
    Set TargetSheet = ThisWorkbook.Sheets("Sheet1")

    ' Use more descriptive variable names.
    Dim SearchRange As Range
    Set SearchRange = TargetSheet.Range("C2:D500000")

    ' Because of the variable name, I have no clue what this is supposed to be.
    ' Keep this in mind when coding.
    Dim FoundCell As Range
    Set FoundCell = TargetSheet.Range("C2")

    ' r is undeclared which means its a Variant.
    ' I've declared it and given it a more proper name to prevent errors.

    ' Notice how the code makes sense as you read it with more descriptive naming conventions.
    ' Any reader will see this and know we are looping through single cells within
    ' a larger range (at least any reader with some VBA knowledge).

    Dim SearchCell As Range
    For Each SearchCell In SearchRange
        ' I prefer to avoid arrow code (which is what I turned your And's into) but it is more efficient overall
        ' to use nested If blocks versus using a longer AND statement. It also makes more sense to the reader.
        If SearchCell.Value > FirstCell.Value Then
            If SearchCell.EntireRow.Interior.ColorIndex <> 4 Then
                If SearchCell.EntireRow.Interior.ColorIndex <> 6 Then
                    Set FoundCell = SearchCell
                End If
            End If
        End If
    Next SearchCell

    ' Even after refactoring this loop I dont see what you're trying to accomplish. Are you highlighting all rows that match
    ' the value of the highest cell value? If so, why not just store the highest value in a variable? Something like:
    ' Dim Foo as Double
    ' Foo = FirstCell.Value
    ' Then much later
    ' If SearchCell.Value = Foo Then DoSomething

    For Each SearchCell In SearchRange
        If FoundCell.Value = SearchCell.Value Then
            If SearchCell.EntireRow.Interior.ColorIndex <> 4 Then
                If SearchCell.EntireRow.Interior.ColorIndex <> 6 Then
                    SearchCell.EntireRow.Interior.ColorIndex = 22
                End If
            End If
        End If
    Next SearchCell

    ' Select second highest value not already selected (as designated by
    ' highlights green, yellow, and red, which is first highest)

    ' No need to declare a new range variable since the first one doesnt need to be reused.

    Set SearchRange = TargetSheet.Range("C2:D500000")
    Set FoundCell = TargetSheetRange("C2")
    For Each SearchCell In SearchRange
        If r.Value > q Then
            If r.EntireRow.Interior.ColorIndex <> 22 Then
                If r.EntireRow.Interior.ColorIndex <> 4 Then
                    If r.EntireRow.Interior.ColorIndex <> 6 Then
                        Set FoundCell = SearchCell
                    End If
                End If
            End If
        End If
    Next SearchCell
    For Each SearchCell In SearchRange
        If FoundCell.Value = SearchCell.Value Then
            If SearchCell.EntireRow.Interior.ColorIndex <> 22 Then
                If SearchCell.EntireRow.Interior.ColorIndex <> 4 Then
                    If SearchCell.EntireRow.Interior.ColorIndex <> 6 Then
                        SearchCell.EntireRow.Interior.ColorIndex = 20
                    End If
                End If
            End If
        End If
    Next SearchCell


    'Designates 1st highest with the number 1
    Set SearchRange = TargetSheet.Range("V2:V500000")
    For Each SearchCell In SearchRange
        If SearchCell.EntireRow.Interior.ColorIndex = 22 Then
            ' Be sure to qualify your reference to the value of the cell
            SearchCell.Offset(0, 1).Value = "1"
        End If
    Next


    'Designates second highest with the number 2
    Set SearchRange = TargetSheet.Range("V2:V500000")
    For Each SearchCell In SearchRange
        If SearchCell.EntireRow.Interior.ColorIndex = 20 Then
            SearchCell.Offset(0, 1).Value = "2"
        End If
    Next
End Sub

Option Explicit

I cannot stress the importance of this being at the top of ALL of your code modules. What Option Explicit does is it causes a compile-time error when a variable is undeclared. This prevents run-time errors when you try to use variables that aren't set properly, and it will save you countless hours of debugging time.

Go To Tools > Options Editor > Require Variable Declaration. You'll thank yourself later.

Variable Naming

Not to be a jerk here, but your variable names are horrible and difficult to understand. You have rng, rng2, rg, q, s, r, cell and the worst part is that you don't need all of them. I declared four variables total (and one of those you didnt even have a variable for, but you did need).

Here's a tip, make sure your variables make sense. You should be able to look at them and have a pretty good idea of what they do. SearchRange is easy to understand: it is the range we are searching in. SearchCell is just as easy to understand: it is the cell we are currently searching in. Finally, FoundCell, you guessed it, is the cell we found using our criteria. It is pretty much bulletproof when you start to code like this (actually, not really. You'll learn that bulletproof coding takes a lot more work than a handful of good variables.) and it makes your code easy to maintain.

Additionally, there is no need to declare two variables if you need one. In other words, if SearchRange is used only for the first loop, and never needed after that, I dont have to make a NewSearchRange for the second loop. I can just use SearchRange.

General Names

Just as Variables need good names, so do subroutines. It is all too easy to take the Macro1 that the recorder gives us, and to leave it this way. When you have larger projects, Macro1 and Macro2 become undistinguishable, and god forbid you have a Module1 and Module2 as well. Name everything. That's pretty much my mantra. From Worksheets to Tables, and PivotTables, and Workbooks, to code modules, subs, functions, etc., give it a proper name. The sooner you get in the habit, the more time you'll save.

Implicit Object References

You'll likely hear this one a lot, so it is important to learn. Whenever you are working on an object, you must consider the scope of that object. While Range("A1") looks fine to the untrained eye, anyone worth their salt in the VBA community will point out that it is a unqualified Range reference. Even worse, is if we have Foo = Range("A1") and one step further is this nasty bit:

Dim Foo
Foo = Range("A1")

It looks harmless right? Wrong. Foo is Dim'ed but it isnt given a type so it is now the dangerous Type Variant which is a known problem-child. Variants are great when you need them, but they have a habit of rearing their ugly head for those knew to the language. But wait, there's more! Range("A1") is unqualified on both sides. So this means it is actually:

Foo = ActiveSheet.Range("A1").Value

Which is fine if it is what you meant but it may not be what you meant. The thing is, not only do you not know what the Activesheet is at the time of the code running (unless you Activate it, which is it's own problem) but you also don't have control over the type going into Foo. It could be a String, or an Integer, or a Double. If you use Set Foo it'll be a Range. Foo will happily take anything you give it, which is a problem.

To solve this, be smart about your code:

Dim Baz as Worksheet

' I use ActiveSheet, but you can use any sheet reference here.
' For example, 'ThisWorkbook.Sheets("Bar")' is quite common.
Set Baz = ActiveSheet 

Dim Foo as String
Foo = Baz.Range("A1").Value

Know I know **exactly* what my code is doing, and I can debug it much faster if something breaks.

Indentation

This is a pet peeve of mine, and it is a pet peeve of the community as well. Always indent your code (properly) and never post code on SO that is not indented. We will be cursing your name as we indent it ourselves (or, even more frequently, we just refuse to help). A lack of indentation will make bad code even harder to read.

Shameless Plug For Rubberduck

Mat's Mug and his team have a tool called 'Rubberduck' that goes a long way towards enabling you to fix these problems. Everything from indentation, to variable naming and variable use, even to Function and Subroutine calls. I highly suggest checking it out: http://rubberduckvba.com/ .

In Closing

Whatever you do, don't simply copy and paste my code, throw it into your module, and just go on your merry way. I spent time on this to help you learn, and my hope is that six months from now you will be in my shoes. If you do decide to forego the learning opportunity here, you will miss out on all of the things VBA can really offer.

Best of luck!

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.