Another VBA question (I'm on fire lately)
As the title says, I am trying to sum a column that can can be of a variable length and then stick that sum in cell F3, but I am running into a an "application or object defined error.
Here's my code:
Dim last As Range, sum As Variant
ActiveSheet.Range("M8").Select
Set last = Selection.End(xlDown)
With Worksheets("Data")
sum = WorksheetFunction.sum(.Range("M8:M" & last))
End With
Range("F:3") = sum
With Worksheets("Data")
.Range("F3").Value = Application.Sum(.Range(.Range("M8"), .Range("M8").End(xlDown))
End With
Using your method, last needs to be a Long to which you assign the row number.
Dim last As Long
Dim sum As Long
ActiveSheet.Range("M8").Select
last = Selection.End(xlDown).Row
With Worksheets("Data")
sum = WorksheetFunction.sum(.Range("M8:M" & last))
End With
Range("F3") = sum
You could also do it a little more efficiently, by using
last = ActiveSheet.Range("M8").End(xlDown).Row
and not using the Select.
Use this function to robustly count the non-empty cells down from a cell.
' Enumerate non-empty cells down the rows.
Public Function CountRows(ByRef r As Range) As Long
If IsEmpty(r) Then
CountRows = 0
ElseIf IsEmpty(r.Offset(1, 0)) Then
CountRows = 1
Else
CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
End If
End Function
There is a non VBA way. In cell F3 type the following:
=SUM(OFFSET($M$8,0,0,COUNTA(M:M),1))
NB - this assumes the only content of column M are the numbers you'd like to sum
Related
I'm using the following function to find out whether values of two cells are in two columns.
I have to compare 250 sets of two-cells with 6500 sets of two-cells.
Excel spent 30 seconds to caculate the result.
Could I improve the calculation efficiency?
Public Function CompareWithTwoCells(twoCells As Range, twoCols As Range)
Dim result As String
result = "False"
For n = 1 To twoCols.Rows.Count
If twoCols(n, 1) = "" Then
Exit For
End If
If twoCells(1, 1) = twoCols(n, 1) And twoCells(1, 2) = twoCols(n, 2) Then
result = "True"
Exit For
End If
Next
CompareWithTwoCells = result
End Function
here's a first step of possible enhancements (explanations in comments):
Public Function CompareWithTwoCells(twoCells As Range, twoCols As Range)
Dim cell As Range
Dim firstVal As Variant, secondVal As Variant
firstVal = twoCells(1, 1) ' store first cell value in a variable
secondVal = twoCells(1, 2) ' store second cell value in a variable
CompareWithTwoCells = "False"
For Each cell In twoCols.Columns(1).SpecialCells(xlCellTypeConstants) ' loop through first column not empty values
If firstVal = cell.Value2 Then ' check one column fisrt
If secondVal = cell.Offset(, 1) Then ' check second column only if first columns check is true
CompareWithTwoCells = "True"
Exit For
End If
End If
Next
End Function
a further significant enhancement would use array instead of ranges
Is there a reason you can't just use MATCH=MATCH? (assuming twoCells is A1:B1 and twoCols is F1:G6500)
=IFERROR(MATCH(A1,$F$1:$F$6500,0)=MATCH(B1,$G$1:$G$6500,0),FALSE)
This is almost instant on my machine.
As per #Zac's suggestion, add:
Dim twoCellsArr, twoColsArr
twoCellsArr = twoCells.Value2
twoColsArr = twoCols.Value2
Then change your twoCells and twoCols to twoCellsArr and twoColsArr.
If your twoCols doesn't change and you're doing repeated comparisons i recommend using a Dictionary to store the twoCols.Value as keys and the row number as values, then perform the lookup and comparing whether they are in the same row.
I have a situation to calculate the average value for a column (this column have many rows with numbers and some rows with #DIV/0! and #VALUE!).
I have a macro written for calculating average function. If its full of numbers, then it easily calculates the average of the column, but if has some #VALUE! or #DIV/0! in a cell. then it returns blank cell. How can I exclude the #VALUE! and #DIV/0! error and to take average for only numbers.
I have over 5K files to calculate the average.
Private Function data As Boolean
Dim Avg_velocity As String
Dim Avg_length As String
Avg_velocity = Application.WorksheetFunction.Average(Sheets("Data").Range("K5:K650"))
Avg_length = Application.WorksheetFunction.Average(Sheets("Data").Range("I7:I607"))
Sheets("Log").Range("A2:AI2").Insert
Sheets("Log").Cells(2, "AA").value = Avg_velocity
Sheets("Log").Cells(2, "AB").value = Avg_length
End Function
Something like this should work quite ok:
Option Explicit
Public Sub TestMe()
Dim myRng1 As Range
Dim myCell As Range
Dim myRng2 As Range
Set myRng1 = Range("A1:A5")
For Each myCell In myRng1
If Not IsError(myCell) Then
If Not myRng2 Is Nothing Then
Set myRng2 = Union(myRng2, myCell)
Else
Set myRng2 = myCell
End If
End If
Next myCell
If Not myRng2 Is Nothing Then myRng2.Select
End Sub
It goes through the range and kindly picks up only the cells, which are not errors:
You can also just use AverageIf to ignore errors by providing a criteria of a really large number, like this:
Avg_velocity = Application.WorksheetFunction.AverageIf(Sheets("Data").Range("K5:K650"), "<9E307")
Should also be able to use aggregate function
=Application.worksheetFunction.Aggregate(1,6,range)
I have 2 columns with USD amounts of payments I need to compare. Data is from two different sources but they should match. Every month there is different number of payments so I dont know if next time there will be 20 or 30 of them. So I need to compare these 2 columens. What I want to do is using if function
If [n3] = [u3] Then
[q3] = "yes"
Else
[q3] = "no"
End If
and I dont know how to use loops to do this with every payment.
Function to count the number of rows with values starting from a cell (defined as a Range object)
Public Function CountRows(ByVal r As Range) As Long
If IsEmpty(r) Then
CountRows = 0
ElseIf IsEmpty(r.Offset(1, 0)) Then
CountRows = 1
Else
CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
End If
End Function
Example Usage inside the Sheet code where you want the check to happen.
Public Sub CheckPayments()
Dim rn as Range, ru as Range, rq as Range
'One price column & first value
Set rn = Range("N3")
'Otjher price column & first value
Set ru = Range("U3")
' Check result column & first value
Set rq = Range("Q3")
Dim i as Long, n as Long
' Count non-empty cells below "N3"
n = CountRows(rn)
'Loop through rows
For i = 1 to n
' Check for matching values
If rn.Cells(i,1).Value = ru.Cells(i,1).Value Then
rq.Cells(i,1).Value = "yes"
Else
rq.Cells(i,1).Value = "no"
End If
Next i
End Sub
I have a data of some binary numbers in few range of cells, from A2 to A8, B2 to B8, and so on, till G column.
Now, I want to check the largest binary number from the above Rows and paste it to the cell, two row below the last used range. (i.e., Largest binary number from Row A to be paste in A10, and so on).
I am not finding any function which can find the value of binary numbers, and the code which I ran finds out the max number considering those as natural numbers.
Your help will be appreciated.
Thank You!
Okay first i made a function that converts binary to decimal and stored in a module. (You can store it wherever you want) This function handles any size binary
Function BinToDecConverter(BinaryString As String) As Variant
Dim i As Integer
For i = 0 To Len(BinaryString) - 1
BinToDecConverter = CDec(BinToDecConverter) + Val(Mid(BinaryString, Len(BinaryString) - i, 1)) * 2 ^ i
Next
End Function
Afterwards i made the sub that loops through all binarys on sheet1 (Might need to change this for your sheet)
Sub FindLargestBinary()
On Error Resume Next
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Application.ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Dim tempVal, tempRow As Integer
Dim iCoulmn, iRow As Integer
For iCoulmn = 1 To 7 'Run from A to G
tempRow = 2
tempVal = 0
For iRow = 2 To 8 'Run from row 2 to 8
If BinToDecConverter(ws.Cells(iRow, iCoulmn).Value) > tempVal Then tempVal = BinToDecConverter(ws.Cells(iRow, iCoulmn).Value): tempRow = iRow ' Check if current binary i higher then any previous
Next iRow
ws.Cells(iRow + 1, iCoulmn).Value = ws.Cells(tempRow, iCoulmn).Value 'Print highest binary
Next iCoulmn
End Sub
Hope this helps you out..
You can use the excel function Bin2Dec to change them into decimal
Function MaxBin(r as range)
Dim curmax as long
Dim s as range
For each s in r
If Application.WorksheetFunction.Bin2Dec(s.Text) > curmax Then curmax = Application.WorksheetFunction.Bin2Dec(s.Text)
Next s
MaxBin = curmax
End Function
Assuming your binary values are text strings this formula converts the values to numbers, finds the MAX and then converts back to a text string
=TEXT(MAX(A2:A8+0),"00000")
confirmed with CTRL+SHIFT+ENTER
or you can use this version which finds the max using AGGREGATE function and doesn't require "array entry"
=DEC2BIN(AGGREGATE(14,6,BIN2DEC(A2:A8+0),1))
This code is just to calculate simple moving average. Opened an excel, created dummy array in C row from 1 to 20. I want to create a function for eg: SMA(C7,3) = which should give average of C5:C7.
Coming back to VBA after long time, not able to figure whats the error in the below code.
Function sma1(rng As Range, N As Integer)
Set rng = rng.Resize(-N + 1, 0)
sma1 = Application.WorksheetFunction.average(rng)
End Function
avoid using a cell name as a function
fixed the RESIZE()
used an internal range variable
Function smal(rng As Range, N As Integer) As Variant
Dim rng2 As Range
Set rng2 = rng.Resize(N, 1)
smal = Application.WorksheetFunction.Average(rng2)
End Function
EDIT#1:
Based on Scott's comment:
Function smal(rng As Range, N As Integer) As Variant
Dim rng2 As Range
Set rng2 = rng.Offset(1 - N, 0).Resize(N, 1)
smal = Application.WorksheetFunction.Average(rng2)
End Function
I assume you want the column along side it to give you're SMA (as shown below?):
If so, the below will do it and drag it autocomplete it to the bottom of you column C array:
Sub SMA3()
Range("D7").FormulaR1C1 = "=AVERAGE(R[-2]C[-1]:RC[-1])" 'This is a relative reference (left one cell and up two cells) - This give your three inputs
Range("D7").AutoFill Destination:=Range("D7:D" & Range("C1048576").End(xlUp).Row) 'Autofills the SMA
End Sub
Just an FYI this can be done with existing formula:
=IF(ROW(C1)<$E$1,"",AVERAGE(INDEX(C:C,ROW(C1)-$E$1+1):C1))
E1 contains the number of rows to include.