PDA

View Full Version : Scan lists and shade row with lowest number



Xanther
04-29-2008, 05:29 PM
All I'm trying to do is write up a program that will scan a list of numbers (essentially) and then will shade the entire row that possesses the lowest number. I've got it so that it will locate and report the name of the user with the lowest stats, but the shading part is really throwing me for a loop. My code below. Danke to anyone who can instruct me as to the probably 1 or 2 lines I'm missing.

Sub lowest2()
Dim rw As Long
Dim lowestvalue As Double
Dim fname As String
Dim lname As String

rw = 3
lowestvalue = Cells(rw, 5)
Do Until Cells(rw, 1).Value = ""
If Cells(rw, 5).Value < lowestvalue Then
lowestvalue = Cells(rw, 5)
fname = Cells(rw, 1)
lname = Cells(rw, 2)
End If

rw = rw + 1
Loop

MsgBox "The lowest stat tally is " & fname & " " & lname


End Sub



* This highlighting will be A-G of the row in question.

Ken Puls
04-29-2008, 06:45 PM
Unless feeding back the messagebox is an important part of your task, you don't need VBA for this.

You can set up a conditional formatting rule to do this.

-Highlight the entire sheet
-In Excel 2003 go to Format-->Conditional Formatting-->Choose Formula Is from the dropdown
-In Excel 2007 go to Home Tab-->Conditional Formatting-->New Rule-->Use a formula to determine...

Assuming you are looking for the lowest number in column A, you'd create the rule using the formula:
=MIN($A:$A)=$A1

The set the colour you want to shade the row.

That's it. It will hilghlight the entire row for you, faster than VBA can do it, and with less overhead.

HTH,

Xanther
04-29-2008, 07:03 PM
Thanks for the reply, but I'm doing it in VBA so I can learn VBA. Why, I'm not entirely sure, but it's my new goal. I realize it's not as efficient or simple as just using the GUI and pre-defined Excel stuff, but I want to learn how to program it.

lucas
04-29-2008, 07:04 PM
Doesn't highlight yet but it wil get you started....
Sub lowest()
Dim myRange As Range
Dim answer As Long
Set myRange = Worksheets("Sheet1").Range("G:G")
answer = Application.WorksheetFunction.Min(myRange)
MsgBox answer
End Sub

lucas
04-29-2008, 07:08 PM
I think I missed the boat on this one.....I'll look again.

Digita
04-29-2008, 07:09 PM
Using the loop would take slightly more time. Assuming you have column header in row 1, try this code:

Sub test()
With WorksheetFunction
LineNum = .Match(.Min(Range("A2:A" & Range("A2").End(xlDown).Row)), Range("A2:A" & Range("A2").End(xlDown).Row), 0)
End With
Range("A" & LineNum +1 & ":G" & LineNum +1).Interior.ColorIndex = 3
End Sub

Hope this helps.

Regards


kp

Ken Puls
04-29-2008, 07:55 PM
Thanks for the reply, but I'm doing it in VBA so I can learn VBA. Why, I'm not entirely sure, but it's my new goal. I realize it's not as efficient or simple as just using the GUI and pre-defined Excel stuff, but I want to learn how to program it.
Xanther, as you cruise through your learning mission, just try to make sure that you don't fall into the trap of reaching for VBA too quickly. Recreating the wheel is great for learning, but it becomes very tempting to do it in a live project when it shouldn't be done. (Trust me, been there done that.)

There is an absolutely horrid example of this on MS's own Technet site, that should never have been written. You can see it here (http://www.microsoft.com/technet/scriptcenter/resources/qanda/jan08/hey0129.mspx), displaying how to essentially recreate conditional formatting. MS should know better, IMO.

rbrhodes
04-29-2008, 09:16 PM
Hi X,

Here's my answer to your question (and a little bit more) to encourage you in your 'quest for knowledge'


'Always use! In VBE choose 'Tools/Options' menu. On Editor Tab
' check 'Require Variable Declaration'. Then use at least one
' Capitol letter in all variable names. When you type in a variable
' name VBE will captialize it for you according to the declared
' variable name. No caps = misspelled. Saves a lot of effort
' in debugging...you know - typing misteakes...
Option Explicit
Sub lowest2()
'Note Caps as explained above
Dim Rw As Long 'Row number
Dim sRw As Long 'Saved row number
Dim uMsg As String 'Variable for msgbox
Dim fName As String 'First Name (Col A)
Dim lName As String 'Last Name (Col B)
Dim LowestValue As Double 'Value to check

'Always comment your code no matter what! A month from
' now you will NOT remember! See above, here and below)

'Once your code is running as you expect it to put
' in an errorHandler for the unexpected !
On Error GoTo endo

'Init row variable
Rw = 3

'Clear all old 'Shading'. Here I've used 'Cells' but you
' could limit to to a range
Cells.Interior.ColorIndex = xlColorIndexNone

'Get first value to check
LowestValue = Cells(Rw, 5)
'Check all until no name in Col A
Do Until Cells(Rw, 1).Value = ""
'If Col E value is lower than previous saved value
If Cells(Rw, 5).Value < LowestValue Then
' then save this one as lowest
LowestValue = Cells(Rw, 5)
'Also save names from Col A
fName = Cells(Rw, 1)
'and Col B
lName = Cells(Rw, 2)
'Save current lowest row for shading
sRw = Rw
End If
'Incr to check next row
Rw = Rw + 1
Loop
'Shade Range of cells using saved row variable
Range(Cells(sRw, 1), Cells(sRw, 5)).Interior.ColorIndex = 3

'Inform User which row was lowest
MsgBox "The lowest stat tally is " & fName & " " & lName
'Alternate way using variable to provide access to built in
'Icons and title for MsgBox...
uMsg = MsgBox("The lowest stat tally is " & fName & " " & lName, vbInformation, "This is the lowest!")
'Raise an error on purpose to test error handler
' (Delete next line when errhandler testing is done)
Err.Raise 9
'Normal exit
Exit Sub

'Errored out
endo:
'Inform user of error using Carriage return/LineFeed to break
' up long lines of text and Err.'XXX' to inform user of error
uMsg = MsgBox("Error! Run away!" & vbCrLf & vbCrLf & _
"Stand on a chair and wave your hands!" & vbCrLf & vbCrLf & _
"Yell """"OOPS"""" a lot!" & vbCrLf & vbCrLf & _
"Error number is " & Err.Number & vbCrLf & vbCrLf & "Description is: " & Err.Description, vbCritical)
End Sub



"When called,

by a panther,

Don't anther."

Ogden Nash

Xanther
04-29-2008, 11:45 PM
Wow, that is awesome, and exactly what I'm looking for I believe. Thank you.

Even gave me some new stuff to fool around with :)

rbrhodes
05-01-2008, 11:12 PM
Xanther,

You're welcome, anytime...