Change the colour of a cell that has the maximum value - vba

I'm trying to recolour the cell with the highest value in a range, but whatever method I'm using, there always seems to be one combination that does not work. I'm not rely used to VBA. What I've tried the last is:
Sub HLF()
Dim HLF As Range
Set HLF = WorksheetsFunction.Max(Range("H2:H7"))
Range("HLF").Interior.Color = RGB(0,255,0)
End Sub
It seems that the 'Set' and 'Max' function don't go together. My basic programming logic says that a normal 'Range' should be replaceable by a function that finds a range, but apparently Excel says not. I've also tried by selecting the cell and using 'ActiveCell' instead of 'Range' to color the cell, but a function and select don't seem to go together either. Other supposed solutions seem overly complicated for such a small task.

Max will return a value from your column. This won't, by itself, give you a cell, which is required for a range. What you can do is a small workaround, see below:
Sub test()
Dim HLF As Range, finalHLF
Dim maxNum As Double
Set HLF = Range("H2:H7")
maxNum = WorksheetFunction.Max(HLF)
finalHLF = HLF.Find(what:=maxNum, lookat:=xlWhole).Address
Range(finalHLF).Interior.Color = RGB(0, 255, 0)
End Sub
This will find your max value, then using that max value, will search in the determined range (in your example, H2:H7 for that max value, then return that cell's address. Then you can continue on with the .Color, using the .Address).
But, as has also been suggested, Conditional Formatting might be your safest bet - as it's easy, and doesn't require the use of macros. But try the above and let me know if you have any questions!
Edit: As #asongtoruin pointed out, the above only will highlight one of the max values, so if there are multiple cells of the same max value, only one will be highlighted. The below code will highlight all max values:
Sub test()
Dim HLF As Range, cel As Range
Dim maxNum As Double
Set HLF = Range("H2:H7")
maxNum = WorksheetFunction.Max(HLF)
For Each cel In HLF
If cel.Value = maxNum Then
cel.Interior.Color = RGB(0, 255, 0)
End If
Next cel
End Sub

Max doesn't return the location of the maximum value - it simply tells you what the maximum value is. In this case, your Set HLF = WorksheetsFunction.Max(Range("H2:H7")) is trying to set the range HLF to equal the value of the maximum in your range. This, I think, is why it's throwing out an error.
As #Scott Craner suggests, you can do this through Conditional Formatting fairly easily - select "Use a formula to determine which cells to format" in conditional formatting, set it to apply to the range H2:H7 and set the rule to be =H2=MAX($H$2:$H$7). The advantage of this is it will update as soon as your values do.

Related

Change cell color based on another cell value

In a workbook I have, the D column has a formula in it to derive the last six digits of a value in column C. These columns are located in a sheet titled "JE". I have a dynamic SQL connected query that has values in the A column. That query is located in a sheet titled "required_refs". I essentially, want to write: If the value in the D column cell matches/equals any of the values in that query in sheet "required_refs", turn the F column cell red in sheet JE.
Example: If cell D10 has a value that equals any of the values in column A in "required_refs", turn cell F10 red. In addition, if cell D13 has a value that matches/equals a value in column A in sheet "required_refs", turn F13 red. And so on.
Here is the code I tried. I added it in Sheet "JE":
Code:
Sub ChangeCellColor()
Dim ref_code As Range: Set ref_code = Range("D7:D446").Value
Dim refCode_Confirm As Range: Set refCode_Confirm = Worksheets("required_refs").Range("A:A").Value
Dim colorChange As Range: Set colorChange = Worksheets("required_refs").Range("A:A")
For Each cell In ref_code
If cell.Value = refCode_Confirm.Value Then
Range("F7:F446").ActiveCell.Interior.ColorIndex = 3
Next cell
End If
End Sub
Currently, this code just doesn't do anything. It doesn't turn the F column cell red. I've asked a question similar to this but, the workbook I'm using has changed a bunch since then, and this question is a bit more simple than the previous one.
If anyone could help, I'd really appreciate it. Thanks!
Your code has a number of issues.
.Value returns a basic type, like a string or long. You can't assign this to a range variable.
Your End If and Next cell statements are swapped around. Always use correct indentation so these errors become more obvious.
You have an undeclared variable cell. This can potentially cause bugs. In the VBE, turn on the Tools > Options > Editor > Required Variable Declaration option to force the use of Option Explicit in new modules.
Fixing these issues leads us to this:
Sub ChangeCellColor()
Dim cell As Range
Dim ref_code As Range: Set ref_code = Range("D7:D446")
Dim refCode_Confirm As Range: Set refCode_Confirm = Worksheets("required_refs").Range("A:A")
Dim colorChange As Range: Set colorChange = Worksheets("required_refs").Range("A:A")
For Each cell In ref_code
If cell.Value = refCode_Confirm.Value Then
Range("F7:F446").ActiveCell.Interior.ColorIndex = 3
End If
Next cell
End Sub
Unfortunately, it still doesn't work as you can't compare a single value directly against a column of values in VBA.
This following code corrects this remaining issue. Note the choosing of good meaningful names as well as the use of RVBA for the variables. This is a good tip for how to avoid making similar errors. Also note the use of .Value2 instead of .Value. This is highly recommended.
Sub ChangeCellColor()
Dim rngRef As Range
Dim rngRefsToCheck As Range: Set rngRefsToCheck = Range("D7:D446")
Dim rngRequiredRefs As Range: Set rngRequiredRefs = Worksheets("required_refs").Columns("A")
Dim rngColorChangeRequired As Range: Set rngColorChangeRequired = Columns("F")
For Each rngRef In rngRefsToCheck
If Not IsError(Application.Match(rngRef.Value2, rngRequiredRefs, 0)) Then
rngColorChangeRequired.Cells(rngRef.Row).Interior.ColorIndex = 3
End If
Next rngRef
End Sub
The best and fastest way to achieve the color change would be to use Advanced Filters, thus avoiding the need to loop. However, since you're still learning the basics, I've shown the looping version.

passing a range object to a sub in VBA

Trying to create a subroutine that takes a range cell and calculates the average of the cells in that column. But I get the error: Object Required
How can I correct this?
Sub test()
Dim rg As Range
Set rg = ThisWorkbook.Worksheets(1).Range("B1")
ColumnAverageToTop (rg)
End Sub
Sub ColumnAverageToTop(rg As Range)
'calculates the average of the data in column and puts it above the data
Cells(1, rg.Column).End(xlDown).Offset(1, 0).Value = Application.WorksheetFunction.Average(rg.Columns(rg.Column))
End Sub
Good that there's a comment that is telling what this sub should do: I read it as: If I run "Test()", the following happens: in the passed range's column in row one, the average of that column's values should appear.
There are three problems in your code.
The first is mentioned in previous comments: Use either call ColumnAverageToTop(rg) or ColumnAverageToTop rg in your test-routine. Solution:
Sub test()
Dim rg As Range
Set rg = ThisWorkbook.Worksheets(1).Range("B1")
ColumnAverageToTop rg
End Sub
Now that we will succesfully enter the ColumnAverageToTop routine, there's an issue with passing the parameter to the WorkSheetFunction.Average
It takes arguments as documented here: https://msdn.microsoft.com/en-us/library/office/ff836809.aspx so to keep it simple just make sure to pass a Range-object to it on which the calculation is performed.
Lastly, when using End and Offset, make sure you use them in the right order. Each of these functions will provide a new range object. I see you attempt to get the cell below the passed argument and then go down and get all the other values to calculate the average of that range.
If you truely always need the average of the entire column, I would advise:
Sub ColumnAverageToTop(rg As Range)
'calculates the average of the data in column and puts it in row 1 of column
'We declare where we put the value: Cells(1,1) of the column of the Range passed
'E.g. "B1" passed means that the average will be in "B1".
'Same fore passing "B323"
rg.EntireColumn.Cells(1, 1).Value = WorksheetFunction.Average(rg.EntireColumn)
End Sub
This will include any numerical value in row 1 of the same column of the passed range, even though it will be overwritten with the result. Running the same test multiple times will therefore change the result.
If you really need the average of everything below the 1st row until the first blank row, it should be:
.rg.EntireColumn.Cells(1,1).value = WorksheetFunction.Average(rg.EntireColumn.Range(Cells(2, 1), Cells(2,1).End(xlDown)))
If your need the average of the filled cells below the referenced cell:
.rg.EntireColumn.Cells(1, 1).Value = WorksheetFunction.Average(rg.Offset(1, 0).Resize(rg.Offset(1, 0).End(xlDown).Row - rg.Offset(1, 0), 1))
Hope this helps you out.

Finding average of selection and then assigning it to a cell

I am attempting to create some dynamic code that, at this point, will select a bunch of cells, move the selection over two columns, then find the average of that selection and send that value to a cell. This is what I have so far, I am getting stuck at averaging the selection I've made:
Sub StatMakersub(Rng1 As Range)
Dim MyRange As Range
Dim Cell As Object
Dim InQuestion As Range
Dim SelAvg As Object
'Check every cell in the range for matching criteria.
For Each Cell In Rng1
If Cell.Value = 2000 Then
If MyRange Is Nothing Then
Set MyRange = Range(Cell.Address)
Else
Set MyRange = Union(MyRange, Range(Cell.Address))
End If
End If
Next
'Select the new range of only matching criteria
MyRange.Select
Selection.Offset(0, 2).Select
Set InQuestion = Selection
Range("P2").Formula = "=Average(Selection)"
Range("Q2").Formula = "=STDDEVA(Selection)"
End Sub
I can't find much on the web about how to average range variables.
You can calculate the average of a selection in this way:
Application.WorksheetFunction.Average("Here you put your range")
The result is a value and not an object, so you should use a variable. Taking names from your case you should use it like this:
SelAvgResult = Application.WorksheetFunction.Average(InQuestion)
I put another name for the variable, but you may still use SelAvg if you like. Just remind to define it as a variable (you may choose your desired format depending on the data size) instead of object if you do not need it anymore.
You may use then this variable for setting the value of your desired cell.
I have a last note: your code seems to replicate the already existing formula AVERAGEIF. If your criteria column is for instance column A and value you should use for calculating the average are in column C, You could directly set the value of the cell where you want the average like this:
=AVERAGEIF(A:A, "2000", C:C)
In this case you would avoid VBA.
Have you tried using the Sum worksheet function for calculating the sum of the range?
Xsum = WorksheetFunction.Sum(arrayX)
and dividing the Xsum value with the length of the array?
One thing I should metion is that you do not need to select the range to work with it. You can use it directly and doing so will also improve how fast your code runs.
To insert your worksheet functions, use the Range.Address function to generate a cell reference to put into the formulas.
https://msdn.microsoft.com/en-us/library/office/ff837625.aspx

Counting Rows/Columns of Selected Range Error

I am trying to determine if a selected range is within a set area... This toggles Copy/Paste restrictions in the spreadsheet. I have figured it out, I think, but I'm getting a run-time error 6 (Overflow) if you select an entire row or column. This is what I've got..
Function BETWEENROWS(ByVal Selected As Range, ByVal Min As Double, ByVal Max As Double) As Boolean
Dim LastRow As Integer
LastRow = Selected.Row + Selected.Rows.Count - 1
If BETWEEN(Min, Selected.Row, Max) = True And BETWEEN(Min, LastRow, Max) = True Then
BETWEENROWS = True
Else
BETWEENROWS = False
End If
End Function
There is one for columns BETWEENCOLUMNS as well and the function BETWEEN just returns True/False if a given number is between a min and max value.
This is working great, however, if an entire row/column is selected it's throwing an error and I'm not too familiar with VBA and the only way that I know of bypassing the error is with On Error Resume Next but that seems like I'm putting a bandaid on it and would like to figure out how to fix it another way.
Your LastRow variable is not the correct type for a number as large as the max columns/rows of the spreadsheet. Change the type to Long:
Dim LastRow As Long
You are getting an overflow error because you have made the LastRow variable an integer. Since there are more rows in an entire column then can fit in an integer variable, it triggers the overflow. You could fix this by changing the LastRow variable to be type Long
However, rather then comparing row values you may want to look into the Intersect() function. Given two (or more) ranges it will return the range object that represents the intersection of the two ranges. You could then check that intersection. If they don't intersect the range object will be Nothing. There is a good tutorial for this function at ozgrid.com
UPDATE
Here is the code to ensure range intersects fully using the Intersect() function
'// Run a test here to make sure Intersect does not return Nothing
If (TestRNG.Count <= ISectRNG.Count) And (Intersect(TestRNG, ISectRNG).Count = TestRNG.Count) Then
'// All of TestRNG falls within ISectRNG
End If

Get the current cell in Excel VB

I have a small script in Excel/VB that I'm trying to get working. All I want to do is select a dynamic range of data to copy but I can't seem to find any help/code on how to get the grid data (like A11).
Here is code I have from macro recording that selects the range of data:
Range("D291:D380").Select
I was hoping I could just do Range(Current).Select or something but that doesn't work.
How do I get the current cell using VBA?
Have you tried:
For one cell:
ActiveCell.Select
For multiple selected cells:
Selection.Range
For example:
Dim rng As Range
Set rng = Range(Selection.Address)
This may not help answer your question directly but is something I have found useful when trying to work with dynamic ranges that may help you out.
Suppose in your worksheet you have the numbers 100 to 108 in cells A1:C3:
A B C
1 100 101 102
2 103 104 105
3 106 107 108
Then to select all the cells you can use the CurrentRegion property:
Sub SelectRange()
Dim dynamicRange As Range
Set dynamicRange = Range("A1").CurrentRegion
End Sub
The advantage of this is that if you add new rows or columns to your block of numbers (e.g. 109, 110, 111) then the CurrentRegion will always reference the enlarged range (in this case A1:C4).
I have used CurrentRegion quite a bit in my VBA code and find it is most useful when working with dynmacially sized ranges. Also it avoids having to hard code ranges in your code.
As a final note, in my code you will see that I used A1 as the reference cell for CurrentRegion. It will also work no matter which cell you reference (try: replacing A1 with B2 for example). The reason is that CurrentRegion will select all contiguous cells based on the reference cell.
The keyword "Selection" is already a vba Range object so you can use it directly, and you don't have to select cells to copy, for example you can be on Sheet1 and issue these commands:
ThisWorkbook.worksheets("sheet2").Range("namedRange_or_address").Copy
ThisWorkbook.worksheets("sheet1").Range("namedRange_or_address").Paste
If it is a multiple selection you should use the Area object in a for loop:
Dim a as Range
For Each a in ActiveSheet.Selection.Areas
a.Copy
ThisWorkbook.worksheets("sheet2").Range("A1").Paste
Next
Regards
Thomas
If you're trying to grab a range with a dynamically generated string, then you just have to build the string like this:
Range(firstcol & firstrow & ":" & secondcol & secondrow).Select
I realize this doesn't directly apply from the title of the question, However some ways to deal with a variable range could be to select the range each time the code runs -- especially if you are interested in a user-selected range. If you are interested in that option, you can use the Application.InputBox (official documentation page here). One of the optional variables is 'type'. If the type is set equal to 8, the InputBox also has an excel-style range selection option. An example of how to use it in code would be:
Dim rng as Range
Set rng = Application.InputBox(Prompt:= "Please select a range", Type:=8)
Note:
If you assign the InputBox value to a none-range variable (without the Set keyword), instead of the ranges, the values from the ranges will be assigned, as in the code below (although selecting multiple ranges in this situation may require the values to be assigned to a variant):
Dim str as String
str = Application.InputBox(Prompt:= "Please select a range", Type:=8)
Try this
Dim app As Excel.Application = Nothing
Dim Active_Cell As Excel.Range = Nothing
Try
app = CType(Marshal.GetActiveObject("Excel.Application"), Excel.Application)
Active_Cell = app.ActiveCell
Catch ex As Exception
MsgBox(ex.Message)
Exit Sub
End Try
' .address will return the cell reference :)