Hello I recently started to code in VBA and would like to implement the function 'AverageIF'.
In the link you can see that in column B there are values after 00:00 and I would like to get the Average of the column B, starting with B2 through B32.
Furthermore I would like to put the answer in B33.
The first code that i am working is seen here, this wil get the AverageIF:
noxGem = WorksheetFunction.averageif(Sheet2.Range("B" & beginRow & ":" & "B" & offsetCellNum2), ">0")
In the above code I assumed that Row B2 till Row B32 will be checked for values bigger than 0. I don't know if that is the correct notation, because I am getting an error :
My second code is seen here, this will put the averageIF in B33:
Worksheets("Sheet2").Range("B" & offsetCellNum).Value = noxGem
I think this code is working, because i have putted the data (B2:B32) with this code in a loop.
Do you guys maybe have any suggestion to what the problem would be?
Much appreciated!
EDIT
I have posted my whole code, My apologies!
The Error message = Error 424 Object Required
Sub averageif_1()
Dim noxValue As Double 'De waarde die je gaat nemen moet een decimaal
getal worden. Single kan ook gebruikt worden
Dim noxCellNumm As String 'Je gaat in de kolom I zoeken per rij van 24 dus
de waarde moet steeds veranderen I2 I3 I4 etc etc..
Dim x As Integer 'Dit geeft voor de 'GEM_Sheet0' aan, in welke rij de data
wordt opgeslagen
counter = 0
offsetCellNum = 2
beginRow = 2
eindRow = 745
Dim noxGem As Double
While counter < 24
Select Case counter
Case Is = 0
x = beginRow
x2 = eindRow
For i = x To x2 Step 24
noxCellNumm = "I" & i
noxValue = Worksheets("Sheet1").Range(noxCellNumm).Value
'Debug.Print strValue
Worksheets("Sheet2").Range("B" & offsetCellNum).Value =
noxValue
offsetCellNum = offsetCellNum + 1
Next
Debug.Print "00:00"
offsetCellNum2 = offsetCellNum - 1
noxGem = WorksheetFunction.averageif(Sheet2.Range("B" &
beginRow & ":" & "B" & offsetCellNum2), ">0")
'noxGem = WorksheetFunction.averageif
'noxGem = WorksheetFunction.averageif(Sheet2.Range("B2:B33"),
"=0")
Debug.Print noxGem
Worksheets("Sheet2").Range("B" & offsetCellNum).Value = noxGem
counter = counter + 1
offsetCellNum = 2
beginRow = beginRow + 1
Case Else
counter = 100
End Select
Wend
End Sub
Your code would be easier to debug if you declared all of your variables.
Put Option Explicit at the top of your code to force this.
To have this happen all the time, under Tools/Options select that option:
Had you done that you might find that Sheet2. in your AverageIf line is flagged as an undeclared variable, and that there is no worksheet with that CodeName (different from the WorksheetName) in your active workbook.
Related
I want to automate a calculation for a measurement data Excel file.
While I made the function work, I could only figure out how to do that for one row at a time. The calculation is specific to the data on every row.
I thought I could change the Range("J3") value to Range("J3:J52") for a capacity of 50 calculations.
How do I make the function calculate for every row, separately, using the data of said specific row?
It doesn't matter if it runs for all 50 rows or if I have to figure out some loop function to find how many rows to calculate for, as long as one button press in the end will make the magic happen.
I have included a screenshot of the sheet for reference, the main calculation is done in Excel, but what this is doing is choosing the correct option out of a few different correction calculations and explaining to the user why.
I think there are some unnecessary Dim lines at the start but if it runs, I wasn't going to remove them.
'The main function, activated by a simple button Sub'
Function ISO16032()
'DeltaL Range'
Dim DeltaL As Range
Set DeltaL = Range("F3")
'Result is the corrected value in G column'
Dim Result As Long
'Note is the calc note in H column'
Dim Note As String
'X is the DeltaL between noise and background noise'
Dim x As Long
x = Range("F3").Value
Select Case Range("F3").Value
'No correction when X = > 10'
Case 10.6 To 200
Result = Range("J3")
Range("G3").Value = Result
Note = "No correction"
Range("H3").Value = Note
'Correction according to ISO16032 when X = between 4 and 10'
Case 3.6 To 10.5
Result = Range("K3")
Range("G3").Value = Result
Note = "Correction per ISO16032"
Range("H3").Value = Note
'Maximal correction value set to 2,2 dB if X < 4'
Case 0.1 To 3.5
Result = Range("L3")
Range("G3").Value = Result
Note = "Correction limit set to 2,2 dB"
Range("H3").Value = Note
'If x = < 0, the measurement is invalid'
Case Else
Note = "Repeat measurement!"
Range("H3").Value = Note
End Select
End Function
Hi and welcome to stackoverflow, I think that a simple loop, with the addition of an argument to your ISO function allows you to solve your problem like this
Sub Looping()
For i = 3 To 52
' Convert i to String because we need to concatenate with the letter F, G, H...
Call ISO16032(CStr(i))
Next
End Sub
Function ISO16032(Cell_X)
'DeltaL Range'
Dim DeltaL As Range
Set DeltaL = Range("F" + Cell_X)
'Result is the corrected value in G column'
Dim Result As Long
'Note is the calc note in H column'
Dim Note As String
'X is the DeltaL between noise and background noise'
Dim x As Long
x = Range("F" + Cell_X).Value
Select Case Range("F" + Cell_X).Value
'No correction when X = > 10'
Case 10.6 To 200
Result = Range("J" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "No correction"
Range("H" + Cell_X).Value = Note
'Correction according to ISO16032 when X = between 4 and 10'
Case 3.6 To 10.5
Result = Range("K" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "Correction per ISO16032"
Range("H" + Cell_X).Value = Note
'Maximal correction value set to 2,2 dB if X < 4'
Case 0.1 To 3.5
Result = Range("L" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "Correction limit set to 2,2 dB"
Range("H" + Cell_X).Value = Note
'If x = < 0, the measurement is invalid'
Case Else
Note = "Repeat measurement!"
Range("H" + Cell_X).Value = Note
End Select
End Function
EDIT: think indented your code like I did to make it more readable too (or like #Darren Bartrup-Cook did when editing your question)
This is more of an example of how to calculate each row.
Just getting your code to work across multiple rows.
Cells
With...End With Statement
'No need for Sub to call function that doesn't return anything.... just write a sub.
Public Sub ISO16032()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, 10).End(xlUp).Row
Dim RowCounter As Long
Dim Result As Long
Dim Note As String
'Only calculate if there is data in rows 3 onwards.
If LastRow >= 3 Then
'Reset results on each pass.
'Assuming -1 is an impossible answer so code knows
'not to put anything on Case Else.
Result = -1
Note = ""
'Cycle through each row and calculate.
For RowCounter = 3 To LastRow
Select Case .Cells(RowCounter, 6) 'Look at column F(column 6) on each row.
Case 10.6 To 200
Result = .Cells(RowCounter, 10)
Note = "No corrections."
Case 3.6 To 10.5
Result = .Cells(RowCounter, 11)
Note = "Correction per ISO16032"
Case 0.1 To 3.5
Result = .Cells(RowCounter, 12)
Note = "Correction limit set to 2,2 dB"
Case Else
Note = "Repeat measurement!"
End Select
'Place results on sheet.
.Cells(RowCounter, 7) = IIf(Result >= 0, Result, "")
.Cells(RowCounter, 8) = Note
Next RowCounter
End If
End With
End Sub
I'm trying to create a function that calculates Drawdown.
It would work as follows:
I have a series of quotes for a specific stock in column B: B (example)
I want to know the maximum drawdown, that is, how much would be the biggest decrease in the quote.
In this case the biggest indentation occurs in the yellow area!that is, the formula would look like: Drawdown = (MaxValue/Value)-1 ==> Drawdown = (13/9)-1
I tried as follows, with no result:
Public Function MDD(ByVal Selection0, ByVal Selection1)
'Function Max DrawDown
Dim i As Long
Dim Drawdown0 As Long
Dim Drawdown1 As Long
i = 2
Drawdown0 = "(" & Selection0 & "/MAX(" & Selection1 & ")) - 1"
While i < Plan1.Range("B" & Rows.Count).End(xlUp).Row + 1
Drawdown1 = "(" & Selection0 & "/MAX(" & Selection1 & ")) - 1"
If Drawdown1 > Drawdown0 Then
Drawdown0 = Drawdown1
End If
i = i + 1
Wend
MDD = Drawdown0
End Function
Sub lsMDD()
Application.MacroOptions Macro:="MDD", Category:=4
End Sub
Where's the error?
You don't need to iterate over the range. Look at Application.WorksheetFunction - it's got everything you need.
Public Function MDD(ByVal pRange As Variant) As Variant
MDD = Application.WorksheetFunction.Max(pRange) / Application.WorksheetFunction.Min(pRange) - 1
End Function
I am new to excel and VBA so apologies for silly question or mistake.
i have some 2000 excel data in sheet2 and the data req in sheet 1
I need to know how many ticket which starts with INC and priority P2 P3 are there and same way how many tickets which starts with SR are there. also out of them how many are in closed state and how many are active.
Sub US_Data()
Dim z As Long
Dim C As Range
z = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
For Each C In Sheet2.Range(Sheet2.Cells(2, 1), Sheet2.Cells(z, 1))
If Left(C.Value, 3) = "INC" Then
Sheet1.Cells(8, 6) = Sheet1.Cells(8, 6) + 1
End If
Next C
End Sub
Thank you
Why use VBA at all? This can be done with simple formulas. If you don't want to use pivot tables, manually create the headings (Blue in the screenshot), then put this formula into cell H3, copy across and down.
=COUNTIFS($A:$A,$G3&"*",$B:$B,H$1,$C:$C,H$2)
Change the layout if you want. The point is that you don't need VBA for that. Formulas will be a lot faster than re-inventing a CountIfs with VBA.
Sub US_Data()
Dim z As Long
Dim HighCount as Long
Dim ModerCount as Long
Dim LowCount as Long
Dim OpenCount as Long
Dim ClosedCount as Long
Dim C As Range
z = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
For Each C In Sheet2.Range(Sheet2.Cells(2, 1), Sheet2.Cells(z, 1))
If Left(C.Value, 3) = "INC" Then
If C.Offset(0,1).Value = "2 - High" Then HighCount = HighCount + 1
If C.Offset(0,1).Value = "3 - Moderate" Then ModerCount = ModerCount + 1
If C.Offset(0,1).Value = "4 - Low" Then LowCount = LowCount + 1
If C.Offset(0,2).Value = "Closed" Then ClosedCount = ClosedCount + 1
If C.Offset(0,2).Value = "Open" Then OpenCount = OpenCount + 1
End If
Next C
MsgBox "I have counted " & HighCount & " times High, " & ModerCount & " times Moderate, " & LowCount & " times Low, and respectively " & OpenCount & " and " & ClosedCount & " open and closed instances.", vbOkOnly, "FYI"
Sheet1.Cells(8, 6) = HighCount
End Sub
This would be one way of doing it, you can fill the cells necessary with those variables.
So, I haven't figured out how to do this.
Basically, I want something like this:
P1 P2 P3 TOTAL SCORE
-- -- -- P1 P2 P3
21 / 13 1 2 0
/ 17 10
6 7 /
So, the three columns must compare to one-another (the "/" means that the player didn't play that game, but it doesn't have to be printed), the greatest among the three gets a +1 value in the TOTAL SCORE tab.
Plus, is there any easier way to do this than comparing one cell to another cell? I mean, is there a possibility to drag and mark all cells on all of the three columns and make sure that they only compare the cells in the three columns IN THE SAME ROW?
Let us assume that the data appears as in the picture in Sheet1 (Don't change the structure):
Open an Excel
Press ALT & F11 to open Visual Editor
Add a module from > Insert (in the Upper toolbar) - Module ( third option)
Paste the below codes & execute Sub Evaluation() (press F5 when your cursor is in Sub Evaluation)
To store lastrow in order to continue from the next record i use sheet2 range A1
Try:
Option Explicit
Public Sub Process_Data(ByVal I_Value As Long)
Dim LastRow As Long
Dim i As Long
Dim CA As Integer
Dim CB As Integer
Dim CC As Integer
With Sheet1
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = I_Value To LastRow '<= Lets say that the first score is at sheet1 column A row 3.LastRow represent the row of the last data in column A
CA = 0
CB = 0 '<= Every time that i change value we zero our variables to get the new value
CC = 0
If .Range("A" & i).Value = "/" Then '<= Check if there is a number or "/".if there is "/" we zero variable
CA = 0
Else
CA = .Range("A" & i).Value
End If
If .Range("B" & i).Value = "/" Then
CB = 0
Else
CB = .Range("B" & i).Value
End If
If .Range("C" & i).Value = "/" Then
CC = 0
Else
CC = .Range("C" & i).Value
End If
If CA > CB And CA > CC Then ' <= Check which number is bigger
.Range("E3").Value = .Range("E3").Value + 1 '<= At one point to each category
ElseIf CB > CA And CB > CC Then
.Range("F3").Value = .Range("F3").Value + 1
ElseIf CC > CA And CC > CB Then
.Range("G3").Value = .Range("G3").Value + 1
End If
Next i
End With
End Sub
Sub Evaluation()
Dim Value As Long
Dim LastRow As Long
LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
If (LastRow = 2) Or (LastRow = Sheet2.Range("A1").Value) Then '<= Check if the table has new data
Exit Sub
Else
If Sheet2.Range("A1").Value = "" Then '<=Check which value will adopt be i
Value = 3
Else
Value = Sheet2.Range("A1").Value + 1
End If
End If
Call Process_Data(I_Value:=Value)
Sheet2.Range("A1").Value = Sheet1.Range("A" & Rows.Count).End(xlUp).Row '<= Record the lastrow processed out
End Sub
Use the LARGE function to find the highest number for the individual games on the left. Then use an IF statement out to the right to check if the value of the LARGE function matches the player's game score. If it does match (TRUE), assign a value of 1. If it doesn't match (FALSE), assign a value of 0. Then SUM each player's modifiers that you've assigned with the IF function.
If ties are possible in the individual game scores, you'll also need to nest another IF function to handle that possibility.
Basically I have 7 cells that could be populated with text (b2, b4, b6, b8, b10, b12 and b14). I want to the code to check each of the cells to see if they have a value and send only the cells that do have a value in an email. For formatting purposes the cells pasted into the email need to have one empty cell in between and the cells need to be kept in the order they are in originally, just without the unnecessary blank cells.
I've never officially learned VBA I've only taught myself on a case by case scenario so there could be an easy solution that I'm missing. Often I can debug and find the problem but in this case Excel completely freezes and turns "Not Responding". I have a feeling that means I've got a loop somewhere unresolved but I don't really understand how. The code -seems- to run up until Range("A2").Value = Line(LineCount1). Any suggestions would be appreciated.
Public Sub SingleEmail()
Dim LineCount1 As Integer
Dim LineCount2 As Integer
Dim LineCount3 As Integer
Dim LineCount4 As Integer
Dim LineCount5 As Integer
Dim LineCount6 As Integer
Dim LineCount7 As Integer
Dim NumOfLines As Integer
Range("A2", "A14").ClearContents
LineCount1 = 2
Range("A2").Value = Line(LineCount1)
LineCount2 = 2 + LineCount1
Range("A4").Value = Line(LineCount2)
LineCount3 = 2 + LineCount2
Range("A6").Value = Line(LineCount3)
LineCount4 = 2 + LineCount3
Range("A8").Value = Line(LineCount4)
LineCount5 = 2 + LineCount4
Range("A10").Value = Line(LineCount5)
LineCount6 = 2 + LineCount5
Range("A12").Value = Line(LineCount6)
LineCount7 = 2 + LineCount6
Range("A14").Value = Line(LineCount7)
NumOfLines = Range("n3").Value
If Range("A2") <> "" Then
Range("A2", "A" & NumOfLines).Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Introduction = ""
.Item.To = "personalemailaddress#Someplace.com"
.Item.CC = ""
.Item.Subject = "Email Subject"
.Item.send
End With
End If
End Sub
Function Line(ByRef LineCount As Integer) As String
Line = ""
Do While Line = "" Or LineCount < 13
If Range("B" & LineCount).Value <> "" Then
Line = Range("B" & LineCount).Value
Else
LineCount = LineCount + 2
End If
Loop
End Function
To answer your question:
If B4 has value and B2 is blank then this While loop become infinite. the LineCount is Stuck on 4, hence no overflow. That's why your code freezes.
Why are you running a loop in the first place. You can simply assign the values like this Range("A2:A14").Value =Range("B2:B14").Value
As per your comment, you need to use And operator in place of OR
Do While Line = "" And LineCount < 13 now the loop will exit if line <> "" or LineCount > 14