How to run the same VBA code on multiple rows - excel

I have a loop that runs until a condition is met in Row 8.
Sub Button1_Click()
Dim i As Double
Dim x As Double
t = Range("K3").Value
i = Range("C8").Value
x = Range("E8").Value
b = Range("B8").Value
Do Until i > (x + t)
i = i + 0.2
Loop
i = i - 0.2 - b
Range("G8").Value = i
End Sub
This does what I require for Row 8 but I need to run on multiple rows. The only value that will be static is cell 'K3'.
i.e.: Once it is done on row 8, run on Row 9 ('C9','E9','B9','G9') and so on. Either this will need to run until row 500, or a count of rows entered.

There will be a whole heap of people here that will give you a much more complete answer but I'm here to answer your direct question.
If you need to apply other enhancements then that can come with other questions. This will help you learn and progress without throwing a heap of code at you that you're not sure of.
Sub Button1_Click()
Dim i As Double
Dim x As Double
Dim lngRow As Long
t = Range("K3").Value
For lngRow = 8 To 500
i = Range("C" & lngRow).Value
x = Range("E" & lngRow).Value
b = Range("B" & lngRow).Value
Do Until i > (x + t)
i = i + 0.2
Loop
i = i - 0.2 - b
Range("G" & lngRow).Value = i
Next
End Sub
That's a simple way to loop through each row.
Considerations you should make on performance are to do with looping, updating cells constantly, calculations and events when updating cells, etc.
But that answers your question.

Related

Running a calculation function for n number of rows

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

Average ten values and then loop through to the next ten values until there are no more values

I have a dataset that consists of 5 different variables. As shown below.
Value1 Value 2 Value 3 Value 4 Value 5
1200.08031 104.9940186 28.05707932 23.90201187 1198.955811
1200.01948 105.0005951 28.05075455 23.88057899 1198.984619
1199.9152 105.0007782 28.04256058 23.86779976 1199.18042
1199.90651 105.0114594 28.05139923 23.90410423 1199.148926
1200.01079 104.9975433 28.05404663 23.89129448 1198.660034
1199.97603 104.9940186 28.0475502 23.91586685 1198.932129
1199.89782 105.0007782 28.04875183 23.87851715 1198.928833
1200.01948 105.0056458 28.04198837 23.91583633 1199.087524
1199.87175 105.0026855 28.04278946 23.91485214 1198.896851
1199.97603 105.0054626 28.04265976 23.9235096 1199.426514
Each of these variables has around 15,000 data points. To reduce the number of data points I want to average every ten data points into one data point and assign this value to a cell on another sheet. I want it to look like:
Value1Avg Value 2Avg Value 3Avg Value 4Avg Value 5Avg
1200.08031 104.9940186 28.05707932 23.90201187 1198.955811
I cannot get the average function to loop through every ten data points.
I have tried to run a loop that goes through each column and averages the values and places them on a different sheet, but I am not incrementing the variables correctly I believe.
Set wb = ThisWorkbook
Set sht1 = wb.Sheets("RawData")
Set sht2 = wb.Sheets("FilteredData")
ii = 2
j = 11
dd = 2
k = 20
n = 1
LastRow = sht1.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
For i = 1 To LastRow
Set Myrange = sht1.Range("E" & ii, "E" & j)
sht2.Range("A" & n).Value =Application.WorksheetFunction.Average(Myrange)
Set Myrange = sht1.Range("B" & ii, "B" & j)
sht2.Range("B" & n).Value = Application.WorksheetFunction.Average(Myrange)
Set Myrange = sht1.Range("C" & ii, "C" & j)
sht2.Range("C" & n).Value = Application.WorksheetFunction.Average(Myrange)
Set Myrange = sht1.Range("H" & ii, "H" & j)
sht2.Range("E" & n).Value = Application.WorksheetFunction.Average(Myrange)
Set Myrange = sht1.Range("D" & ii, "D" & j)
sht2.Range("D" & n).Value = Application.WorksheetFunction.Average(Myrange)
ii = ii + 10
j = j + 10
n = n + 1
Next i
I expect to go to sheet 2 and see the averages, but I get:
"Run-time error '1004': Method 'Range' of object '_Worksheet' failed"
Here is a potential alternative that may be a little easier to follow by making use of nested loops. This way you do not have to complete the average for each column one by one, instead you can just have your action line written once situated inside a row & column loop.
Simplifying variables will also make this easier to update / debug in the future.
Sub Jeeped()
Dim rd As Worksheet: Set rd = ThisWorkbook.Sheets("RawData")
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("FilteredData")
Dim LR As Long
LR = rd.Range("A" & rd.Rows.Count).End(xlUp).Row
Dim c As Long 'Column Loop
Dim r As Long 'Row Loop
Dim x As Long 'Paste counter
x = 2
Dim TempAverage As Range
For r = 2 To LR Step 10
For i = 1 To 5 '<-- (Columns A - D)
Set TempAverage = rd.Range(rd.Cells(r, i), rd.Cells(r + 9, i))
ws.Cells(x, i).Value = Application.WorksheetFunction.Average(TempAverage)
Next i
x = x + 1
Next r
End Sub
assumes your variables span Columns A:D on RawData and that the values will be pasted on FilterdData on Columns A:D as well. You can modify the loops to place them in the correct location
https://i.stack.imgur.com/RKcpe.png

Nested Conditions In VBA

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.

Avoid Cell specification when moving across for loop

I am trying to use step functions to describe a curve. This is mainly due to other methods not being as precise as this one, in which the data points are connected by a linear relationship.
I have a table of x-values. Each x-value is taken, and compared to a second table until the following condition is met:
Value2>Value1
Once that is achieved, the second table is used to construct a linear relationship, with which I can accurately calculate the first values actual result, the y-value (assuming y = f(x) ), which is introduced to a last table.
This process has to be repeated then exactly the same way, however the table from which the first value is taken and the table from below which contains the results shifts to the right for every table iteration.
The code I used is as follows:
Sub alpha()
Dim a As Integer
a = 0
Begin_Count:
a = a + 1
Dim l As Integer
For l = 1 To 13
'Check the first value
Val1 = Range(Chr(a + 66) & (l + 269))
'Check the numbers to compare range
Dim i As Integer
For i = 1 To 12:
Val2 = Range(Chr(67) & (i + 284))
If Val2 > Val1 = True Then
'Calculate Cl
dy = (Range("D" & (i + 284)) - Range("D" & (i + 283)))
dx = (Range("C" & (i + 284)) - Range("C" & (i + 283)))
x = (Val1 - Range("C" & (i + 283)))
y = Range("D" & (i + 283))
Cl = ((dy / dx) * x) + y
'Insert Cl
Range(Chr(a + 66) & (l + 299)).Value = Cl
Exit For
End If
Next
Next
If a < 101 = True Then
GoTo Begin_Count
End If
End Sub
This code runs until it reaches the point in which the cells from Excel are labeled "AA","AB",etc., at which the code gives an error.
Can anyone help me out with this?
Instead of:
Range(Chr(a + 66) & (l + 299)).Value = Cl
use
Cells(l+299, a).Value = Cl
In general it's easier to use Cells() with two numeric arguments than to try to create an address string to pass to Range(), particularly if you're working on a single cell.
Just a couple quick things...
Always use Option Explicit in your code modules. It forces you to declare your variables and helps avoid crossing up value types.
Always create a worksheet object, so you can "guarantee" which worksheet your code refers. It makes it more clear, especially when you're involving multiple worksheets (maybe not now, but later).
Finally, refer to the values in your table using the Cells(rowindex,columnindex) format. This way you can index rows and columns numerically.
Option Explicit
sub alpha()
Dim ws as Worksheet
Dim a as Integer
Dim lrow as Integer, lcol as Integer
Dim irow as Integer, icol as Integer
Dim
Set ws = Activesheet
a = 0
Val1 = ws.Cells(lrow, lcol).value
end sub

VBA loop exiting loop on second run

I need some help with some VBA. The code below sorts a bunch of data which is spread horrizonally then apends them vertically which I have posted below:
Sub Test()
Application.ScreenUpdating = False
countrow = ActiveSheet.UsedRange.Rows.Count
countcolumn = ActiveSheet.UsedRange.Columns.Count
numberofiterations = countcolumn / 6
MsgBox "Number of Rows is" & Str(countrow)
MsgBox "Number of Column is" & Str(countcolumn)
ActiveSheet.Select
a = 1
b = 1
c = 6
d = 1
While n < numberofiterations
Range(Cells(a, b), Cells(countrow, c)).Select
Selection.Copy
Sheets(2).Select
ActiveSheet.Cells(d, 1).Select
Sheets(2).Paste
Sheets(1).Select
b = b + 6
c = c + 6
d = d + countrow
n = n + 1
Wend
End Sub
It runs ok once but when running it for the second time it itteraits through to the line:
While n < numberofiterations
I can't find the reason why it drops out the loop the second time. Any help will be apriciated
Thanks,
A few things to consider:
1) Please initialize the value of n. That is, before you start your loop, set
n = 0
explicitly. If you later add other code that happens to set n to some value, you will not get the result you expect
2) When you say
countrow = ActiveSheet.UsedRange.Rows.Count
Range(Cells(a, b), Cells(countrow, c)).Select
You will not get a selection all the way to the bottom of the range IF THE USED RANGE DIDN'T START IN ROW 1. If UsedRange = $Q1:Z20, then UsedRange.Rows.Count = 10, not 26!
This second point is probably not your problem today - but I wanted to point it out as it will bite you another time.
3) I am a huge fan of writing
Option Explicit
at the top of every module. It forces you to be thoughtful about every variable you create, and more likely will make you remember to initialize variables as well. In general it's good practice, and should be right up there on your list with "initialize right before you use".

Resources