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
Related
I have an inventory sheet setup where a user is scanning part numbers into a sheet and a "date scanned" column will display the current date. The formula itself is working fine as it is showing the "today()" function to display the date. However, once the spreadsheet is open, the values now show today's date rather than the original scan in date (because the formula recalculates the date).
I've figured out how to change the formulas to values but I'm struggling with getting the timing right.
The below code does what is intended; it takes a look at all rows with a formula and converts them to values. The problem however, is that if a row does not have a value in it yet, just a formula, it will replace the formula with a blank.
I would like to make the code more robust and only change once a value has been determined by the formula (i.e. once a user scans in a part number). If a part number has not been scanned in, I would like the formula to stay in the column until done so by the user.
Sub makeStatic()
'
'Convert date formula to a static value
'
Dim rng As Range
For Each rng In ActiveSheet.Range("$E$2:E" & ActiveSheet.UsedRange.Rows.Count)
If rng.HasFormula Then
rng.Formula = rng.Value
End If
Next rng
End Sub
I figured this would be a combination of an if statement paired with an event handler but I haven't been able to decipher the best way to do it. Any help would be greatly appreciated.
Let me suggest a solution that gives you the result you are asking for, but in another way than you were sketching.
Let's consider your worksheet having the Part number in column A and Date scanned in column B. Both column A and B are empty, until the scanner enters the part number to column A. To react on a change in a cell in the A and end up with current date in B, you can write the following VBA function:
Option Explicit 'Excel worksheet change event for range A1 to A10
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:A10")) Is Nothing Then
Target.Cells(1, 2).Value = Date
End If
End Sub
Of course you would change the range as needed.
I have a macro that is generally slow due to overuse of LOOKUP formulas. I want to insert some VBA variables to speed these up. I am currently working on speeding up the formula below:in Excel:
=IF(ISNA(MATCH(A2,Summary!B:B,0)),"n",I2-((I2/LOOKUP(2,1/(I:I<>""),I:I))*VLOOKUP(A2,Summary!$G$10:$H$902,2,FALSE)))
in VBA:
"=IF(ISNA(MATCH(RC[-9],Summary!C[-8],0)),""n"",RC[-1]-((RC[-1]/LOOKUP(2,1/(C[-1]<>""""),C[-1]))*VLOOKUP(RC[-9],Summary!R10C7:R902C8,2,FALSE)))"
The portion I need to replace is LOOKUP(2,1/(C[-1]<>""""),C[-1]). All this does is reference the last non empty cell in column I. Right now I have the following code to return the address of the last cell in VBA
Sub FormulaTest()
Set lRow = Range("I1").SpecialCells(xlCellTypeLastCell).Address
End Sub
I am trying to figure out how to implement this "lRow" into the VBA code for the formula. Can anyone steer me in the right direction?
**EDIT 1
Please see Fernando's comment below. He has the right idea however the solution is still off a bit. Ill try to explain it better in a few comments: First off, The first row is always a title row, the last row is always a sum row, the current tab is the "Sales" tab, and the amount of rows in any given Sales tab will vary (could be I1:I59, could be I:1:I323).
In this example I1 is a row title and I59 is the sum of I2:I58. Rows I2:I58 are dollar amounts. My macro places this formula in J2:J58. This formula takes each row's dollar amount (I2:I58) as a percentage of the total (I59) and multiplies it by an input amount on the Summary tab (the VLOOKUP). This amount is then subtracted proportionately from the dollar value in column I with the J cell showing the result.
I am looking to eliminate the need for the LOOKUP function (selects last non empty cell) within my formula above: LOOKUP(2,1/(C[-1]<>""""),C[-1]).
**EDIT 2
Fernando's solution worked. Thank you all for your input
This would return the last non-empty row in column I
with Worksheets("Summary")
lRow = .Cells(.Rows.Count, "I").End(xlUp).Row
end with
So your code would be
sub testy
dim lRow as long
with Worksheets("Summary")
lRow = .Cells(.Rows.Count, "I").End(xlUp).Row
end with
"=IF(ISNA(MATCH(RC[-9],Summary!C[-8],0)),""n"",RC[-1]-_
((RC[-1]/R"&lRow&"C[-1])*VLOOKUP(RC[-9],Summary!R10C7:R902C8,2,FALSE)))"
In your solution you're using xlCellTypeLastCell. This is very useful, but it calculates based on UsedRange, which may not be what you want. with this, if you have data up to row n and then you update the data and now you have less records, the last row with xlCellTypeLastCell will still be n, so be careful with that.
Assuming that you are doing all your work on the active sheet, looking up to a "Summary" sheet:
Sub fillCol()
Dim aRow As Long, bRow As Long
aRow = Cells(Rows.Count, "I").End(xlUp).Row
bRow = Sheets("Summary").Cells(Rows.Count, "I").End(xlUp).Row
Range("J2:J" & aRow).FormulaR1C1 = "=IF(ISNA(MATCH(RC[-9],Summary!C[-8],0)),""n"",RC[-1]-" _
& "((RC[-1]/" & aRow & ")*VLOOKUP(RC[-9],Summary!R10C7:R" & bRow & "C8,2,FALSE)))"
End Sub
You made need to change the columns which contain the contiguous range (in order to determine the last row)
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 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
I have a fairly simple syntax question:
I'm trying to copy and paste n rows from one excel file to another. In addition, I'd like to store the total copied rows into a variable.
Can someone help me accomplish this?
For example:
1)
Activate CSV file
Apply Filter to Column B (Page Title) & uncheck "blanks" ("<>") filter**
Windows("Test_Origin.xlsm").Activate
ActiveSheet.Range("$A$1:$J$206").AutoFilter Field:=2, Criteria1:="<>"
2)
Copy Filtered Lines with data (Excluding Row 1)
Range("B2:F189").Select
Selection.Copy
copiedRowTotal = total *FILTERED* rows copied over from original sheet, then Test Number iterates that many times
copiedRowTotal = Selection.Rows.Count
MsgBox copiedRowTotal
Thanks
An indirect way to do this is
Range("B2:F189").Copy
Range("M2").PasteSpecial xlPasteValues
copiedRowTotal = Selection.Rows.Count
Selection.Clear
The code copies the range & does a paste special operation on a separate location.
By doing this, only filtered rows are copied to M2 & the area (where the filtered rows are pasted) is highlighted when PasteSpecial operation is done.
Doing a Selection.Rows.Count gives one, the number of filtered rows that were pasted.
After figuring out the number of filtered rows, the selection is cleared up.
I don't believe there is a way to get the visible cell count directly. I tried using the 'SpecialCells(xlSpecialCellsVisible)' function, but could not get the correct count with a filter applied. Here is a quick function I wrote that works with a filter applied.
Also be aware that sometimes a filter can mess with the selected range at times, so it's something to note.
Public Sub TestIt()
Dim visibleCount As Long
visibleCount = GetVisibleCount(Sheets(1).Range("A2:H3000"))
MsgBox visibleCount
End Sub
Public Function GetVisibleCount(rng As Range) As Long
Dim loopRow As Range
GetVisibleCount = 0
For Each loopRow In rng.Rows
If loopRow.Hidden = False Then
GetVisibleCount = GetVisibleCount + 1
End If
Next loopRow
End Function
copiedrowtotal = selection.rows.count ' its not selection.totalcells
I think this would do the trick
After seeing your update let me tell you probably these would work
dim i as long
i = Application.WorksheetFunction.Subtotal(2,worksheets("Sheet").Range("B2:F189"))
Now i has the number of filtered rows in it! If you have included header in your range then do -1 at the end else just leave it up
argument 2 in subtotal is => counting the rows and then sheet name
and then specify range to count filtered rows
instead I would select only one column if you applied filter for many columns!
Hope it helps dont forget to accept an answer ! :