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
Related
I cannot get this function to return my values to the output column in excel:
To overcome some intense lookup tables and speed up computation, I am using a pivot table with slicers to output row numbers from filtering. These rows then need to be converted into a column of true/false cells for a large table from which I then want to perform more calculations. To avoid lookups or matching I simply need to step through the list of rows and turn those cells to "true" in the output vector.
Function IncludedinSlicer(input_range As Variant) As Variant
Dim n As Long, j As Long, r As Long
n = input_range.Height ' Height of the column of reference values
' every row in the input_range contains a row number which in the output should be TRUE
' all other rows should be false
Dim output_range As Variant
ReDim output_range(1 To 300000)
' This covers the maximum number of rows
' Initialise all rows to FALSE
For j = 1 To 300000
output_range(j) = False
Next j
' Set only those rows listed in the reference to TRUE
For j = 1 To n
r = input_range(j).Value
If r = 0 Then ' If r=0 then we are beyond the end of the reference table and have captured some blank rows
Exit For ' Exit, to avoid outside-of-array errors
Else
output_range(r) = True
End If
'End If
Next j
' Return results to Excel
' THIS LAST BIT DOES NOT RETURN VALUES TO EXCEL
IncludedinSlicer = output_range
End Function
I know this should be trivial but somehow it has vexed me for literally hours. Please help! Thank you in advance!
EDIT: Found the issue!
First, thank you for pointing out the difference between Height and Rows.Count as I was not aware of this.
Unfortunately, that still left me with the same error in the final cell output (#Value). Luckily in the meantime I tried processing this via Matlab instead and when passing back the results I got the same error. This allowed me to narrow down the problem and I tracked the error to ... (drum roll) ... VBA's 2^16 limit for array size.
My table has close to 2^18 rows so this causes the error.
input_range.Height refers to the literal height in pixels of the range. Try instead input_range.Rows.Count to get the number of rows in the range.
For your function, you should be passing in (and potentially returning) a Range type instead of the ambiguous Variant type.
This will give you direct access to all of the properties of the Range type (i.e. Rows, Columns, Cells) and would probably make it easier to catch your issue that bobajob pointed out.
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.
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.
I'll do my best to try and explain my problem, but it's still a bit fuzzy in my mind so this might not be as clear as it should be, for which I apologize in advance.
Here's the part of my code I'm having trouble with:
If Application.WorksheetFunction.countif(Range("D:D"), Cells(x, firstcolumn).Value) _
And Application.WorksheetFunction.countif(Range("F:F"), Cells(x, firstcolumn).Value) _
And Application.WorksheetFunction.countif(Range("H:H"), Cells(x, firstcolumn).Value) Then
The idea behind this project is to check if the values in "Cells(x, firstcolumn)" are present in columns D, F and H at the same time, and then paste the values somewhere else.
However the number of columns to check for the "Cells(x, firstcolumn)" values could be changed, so values would need to be checked in any number of columns (2, 10 etc). My code works perfectly for the specified Ranges but if one is missing or more are added then it stops working.
The columns to check against are always offset by 2 from the firstcolumn and firstcolumn is always B, it will be checked against D, F, H and so on while columns C,E,G etc have other data not relevant for this part.
My best guess is to have the countif Ranges changed dynamically but I'm at a loss of when and how this should be done...
Could anyone point me towards the right direction in order to achieve this? I can post the full code if needed.
Cheers!
You need to extract a function here. Something like this:
Private Function IsPresentInRange(ByVal source As Range, ByVal value As Variant) As Boolean
IsPresentInRange = Application.WorksheetFunction.CountIf(source, value) > 0
End Function
And then you need a way to figure out what ranges you need to give it for a source parameter - that can be a function of its own, or you can hard-code them somewhere; basically you want to have a concept of a group of ranges to call that function with - this would be the simplest:
Private Function GetSourceRanges() As Collection
Dim result As New Collection
result.Add Range("D:D")
result.Add Range("F:F")
result.Add Range("H:H")
'maintain this list here
Set GetSourceRanges = result
End Function
Ideally you would have some logic coded there, so that you don't need to manually add ranges to that collection every time.
And then you can just iterate these ranges and determine if you get a count > 0 for all of them:
Dim sources As Collection
Set sources = GetSourceRanges
Dim result As Boolean
result = True
Dim sourceRange As Range
For Each sourceRange In sources
result = result And IsPresentInRange(sourceRange, Cells(x, firstcolumn).Value)
Next
If result Then
' whatever you had in that If block
End If
This is my first time using VBA for Excel (I usually code Java and C++), and I was hoping to get some tips to start out.
I want to write a macro for a large data set that will proceed through the following list of conditions to provide a dollar result:
Collect unit size from column A (Possible values 0-8)
Determine whether single or family unit from Column B (Single- 1, Family- 0)
Collect utility code from Column C (code for type of product being assessed)
From this information, a new value will be placed in the row which determines utility costs by taking into account unit size, type of unit, and the product in question. I have thought about using nested Select Case or nested conditionals in a loop, but overall I am pretty lost.
It seems like a worksheet formula might do the trick, but it's hard to tell without knowing what the calculation is. Below is a user-defined function (UDF) that you would put in a standard module. You would call it from a cell like:
=computecosts(A2,B2,C2)
Obviously the code would change depending on how your data is laid out and what your calculation is.
Public Function ComputeCosts(rSize As Range, rFamily As Range, rCode As Range) As Double
Dim lSizeFactor As Long
Dim lFamilyFactor As Long
Dim dCodeFactor As Double
Dim rFound As Range
Const lFAMILY As Long = 0
'Size factor is a function of 0-8, namely adding 1
lSizeFactor = rSize.Value + 1
'Family factor is computed in code
If rFamily.Value = lFAMILY Then
lFamilyFactor = 3
Else
lFamilyFactor = 2
End If
'Code factor is looked up in a different sheet
Set rFound = Worksheets("Sheet2").Columns(1).Cells.Find(rCode.Value, , xlValues, xlWhole)
If Not rFound Is Nothing Then
dCodeFactor = rFound.Offset(0, 1).Value
End If
'do the math
ComputeCosts = lSizeFactor * lFamilyFactor * dCodeFactor
End Function
Thanks for the responses, they were helpful in understanding VBA for Excel. I just ended up putting possible values in a table and then using Match functions within an Index function to pick out the right value.