fengw
06-01-2011, 04:45 PM
Hi,
I'm trying to make a function that only keeps a certain number of maximum numbers in my worksheet. I plan to do this by changing the style of numElements cells if they are the maximum number in the range specified. Afterwards, I plan to empty the cells that are not highlighted so only the max numbers remain.
Here is my code:
Function HighlightMaxNum(sheetName As Worksheet, numElements As Integer)
Dim Count As Integer
Dim MaxNum As Double
Dim Cell As Range
With sheetName
'Loop through the data until numElements different max numbers are highlighted
For Count = 0 To numElements - 1
For Each Cell In sheetName.Range("A2:FO50")
If Cell.Value > MaxNum And Cell.Style <> "Note" Then
MaxNum = Cell.Value
End If
Next
Cells.Find(MaxNum).Style = "Note"
Cells.Find(MaxNum).Value = Cells.Find(MaxNum).Value + 1000
MaxNum = 0
Next
'Delete the cells that are not highlighted
For Each Cell In sheetName.Range("A2:FO350")
If Cell.Style <> "Note" Then
Cell.ClearContents
End If
Next
End With
End Function
To me, this makes logical sense. When I test it however, there seem to be problems with assigning the maximum number. Is that what's wrong?
Thanks,
Kevin
I'm trying to make a function that only keeps a certain number of maximum numbers in my worksheet. I plan to do this by changing the style of numElements cells if they are the maximum number in the range specified. Afterwards, I plan to empty the cells that are not highlighted so only the max numbers remain.
Here is my code:
Function HighlightMaxNum(sheetName As Worksheet, numElements As Integer)
Dim Count As Integer
Dim MaxNum As Double
Dim Cell As Range
With sheetName
'Loop through the data until numElements different max numbers are highlighted
For Count = 0 To numElements - 1
For Each Cell In sheetName.Range("A2:FO50")
If Cell.Value > MaxNum And Cell.Style <> "Note" Then
MaxNum = Cell.Value
End If
Next
Cells.Find(MaxNum).Style = "Note"
Cells.Find(MaxNum).Value = Cells.Find(MaxNum).Value + 1000
MaxNum = 0
Next
'Delete the cells that are not highlighted
For Each Cell In sheetName.Range("A2:FO350")
If Cell.Style <> "Note" Then
Cell.ClearContents
End If
Next
End With
End Function
To me, this makes logical sense. When I test it however, there seem to be problems with assigning the maximum number. Is that what's wrong?
Thanks,
Kevin