passing a range object to a sub in VBA - 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.

Related

(VBA) Custom function refreshing itself with wrong input?

My problem is hard to explain, therefore I added a picture and also shared the sample excel file via my google drive.
What the function should do: Have different item total prices in row "W" and the percentage of transportation costs within the total prices in row "Q" (several other percentage-rows exist for different cost items, this is just to simplify).
Now I SUM the individual item totals.
Then, I apply below function to all percentages in row "Q", which should then give me the total amount of costs, which I then can devide again by row "W" to get the cost percentage of the total.
In my example file, all sub-percentages are equal, but they could as well be different.
The problem that I encounter occurs when I have two sheets with the function below. For some reasons, whenever the function updates on one sheet (and shows the correct value), the function on the other sheet becomes a mess. When I then manually update ("press enter") on the messed-up function, it shows the correct value, but when I go back to the previous sheet, the function is messed up there... I am going crazy : (
And, if I have a third sheet that references "Q" on each sheet, I can never get it to show the correct value for both sheets at the same time, one is always incorrect.
Option Explicit
Dim rCell As Range
Function SUMSubCost(rRange As Range) As Double
Application.Volatile
Dim Total
For Each rCell In rRange
If (Not IsEmpty(rCell)) And (Not IsError(rCell)) Then
Total = Total + (rCell.Value * Range("W" & rCell.Row).Value)
Else
End If
Next rCell
SUMSubCost = Total
End Function
Excel Document
Picture
Without a qualifying worksheet object, your Range("W" & rCell.Row) will always refer to the ActiveSheet, which is not always the one calling your function.
Here's one way to fix it:
Option Explicit
Function SUMSubCost(rRange As Range) As Double
Application.Volatile
Dim Total, rCell As Range
For Each rCell In rRange
If (Not IsEmpty(rCell)) And (Not IsError(rCell)) Then
Total = Total + (rCell.Value * rCell.Worksheet.Range("W" & rCell.Row).Value)
End If
Next rCell
SUMSubCost = Total
End Function

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

sumif code returns error when using column number?

I have a quick question... not sure what I am doing wrong.
I would like to have a named range (single cell) updated with the value from a sumif based on data in another tab of excel. the formula should go through column 2 look for the date and sum any values in column 10.
even when I substitute out the columns with actual hard column letters, I am getting error 1004 method range of object worksheet failed. how can I re-code this to pick up sumif data from another tab?
here is my code
with data_ws
date = #5/13/2014#
[named_range] = worksheetfunction.sumif(.range(.columns(2)), date, _
.range(.columns(10))
end with
You are close and may have an idea from below why yours are not working:
Sub TestSumIf()
Dim oRngA As Range, oRngB As Range
With ActiveCell
.ClearContents
Set oRngA = .Columns(2).EntireColumn ' 1st EntireColumn on the right
Set oRngB = .Columns(3).EntireColumn ' 2nd EntireColumn on the right
.Value = WorksheetFunction.SumIf(oRngA, Date, oRngB)
End With
End Sub
Sample:

Copy/Paste cells next to cells that have certain string

I am trying to look up cells in a certain column that have a string (e.g. Names), copy the corresponding cells in the column to its right (i.e. offset(0,1) ), then paste it to a column in a different sheet. I have the following code to find the range variable that I want. However, I can't select it from a different sheet!
When I use Sheets(1).MyRange.Copy, it doesn't accept it. Am I referring to the range in a wrong way? What am I doing wrong?
Here's code that I use to get MyRange:
Option Explicit
Sub SelectByValue(Rng1 As Range, Value As Double)
Dim MyRange As Range
Dim Cell As Object
'Check every cell in the range for matching criteria.
For Each Cell In Rng1
If Cell.Value = Value Then
If MyRange Is Nothing Then
Set MyRange = Range(Cell.Address)
Else
Set MyRange = Union(MyRange, Range(Cell.Address))
End If
End If
Next
End Sub
Sub CallSelectByValue()
'Call the macro and pass all the required variables to it.
'In the line below, change the Range, Minimum Value, and Maximum Value as needed
Call SelectByValue(Sheets(1).Range("A1:A20"), "Tom")
End Sub
One More Question: Rather than specifying the exact range to look at (e.g. "A1:A20"), I would LOVE to look at all of column A. But I don't want to use ("A:A") so it wouldn't look at all rows of A. Isn't there a method to look only in cells that have entries in column A?
Thank you VERY much.
Al
You only need MyRange.Copy.
To restrict only to cells in column A which might have values, you could use
With Sheet1
Set rngToSearch = Application.Intersect(.Columns(1), .UsedRange)
End With
...or maybe look at .SpecialsCells()

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