Dim i As Integer, j As Integer, k As Integer, l As Integer
i = ActiveSheet.PivotTables(1).TableRange2.Rows.Count + 1
j = ActiveSheet.PivotTables(1).TableRange2.Columns.Count
k = ActiveSheet.PivotTables(1).TableRange2.Rows.Count - 7
For l = 2 To j
Cells(i + 2, l).Value = WorksheetFunction.SumIf(Range(Cells(9, l), Cells(i, l)), ">0", Range(Cells(9, l), Cells(i, l)))
Next l
Hi, I am trying to use sumif function in vba. The point is to do this in loop, which depends on the number of columns. I do not actually now what is wrong here, but I think that probably there is something with criteria I took. I want to sum all cells with number higher than 0 and not sure how to write this.
Use the following function. No need to use "*" for comparing
Cells(i + 2, l).Value = Aplication.WorksheetFunction.SumIf(Range(Cells(9, 2), Cells(i, 2)), "> 0", Range(Cells(9, 2), Cells(i, 2)))
If in your SumIf you are using the Range you are comparing with the Criteria (>0) also as the Range to sum, there is no need to add it inside the SumIf as the third argument.
You could go with the code below:
For l = 2 To j
Cells(i + 2, l).Value = WorksheetFunction.SumIf(Range(Cells(9, l), Cells(i, l)), ">0")
Next l
Related
For the first time I've worked in Excel VBA to find rows in my dataset that contain the same adress as another entry in a cluster. These entries have to be merged and the row then is deleted. I've come up with the following, which works (As far as I can tell from the testing I did on small samples of the set):
Sub Merge_Orders()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim y As Long
Dim x As Long
Dim j As Long
Dim k As Long
For i = 2 To lastrow //for each row, starting below header row
j = 1
y = (Cells(i, 9)) //this is the clusternumber
Do While y = (Cells(i + j, 9)) //while the next row is in the same cluster
x = (Cells(i, 12)) //this is the adresscode
k = 1
Do While x = (Cells(i + k, 12)) //while the current adresscode is the same as the next, iterating until another adresscode is hit
Cells(i, 16) = Val(Cells(i, 16)) + Val(Cells(i + k, 16)) //update cell value
Cells(i, 18) = Cells(i, 18) + Cells(i + k, 18) //update cell value
Cells(i, 19) = Cells(i, 19) + Cells(i + k, 19) //update cell value
If Cells(i, 20) > Cells(i + k, 20) Then
Cells(i, 20) = Cells(i + k, 20) //update cell value
End If
If Cells(i, 21) > Cells(i + k, 21) Then
Cells(i, 21) = Cells(i + k, 21) //update cell value
End If
Cells(i, 22) = Cells(i, 22) + Cells(i + k, 22) //update cell value
Cells(i, 23) = Cells(i, 23) + Cells(i + k, 23) //update cell value
Rows(i + 1).EntireRow.Delete //Delete the row from which data was pulled
k = k + 1
Loop
j = j + 1
Loop
Next i
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub
The problem I'm facing is time. Testing this on a small sample of ~50 rows took over 5 minutes. My entries total over 100K rows. It's been running for over a day with no end in sight. Is there a way to optimize this so I don't have to wait until I'm grey?
Kind regards,
Rob
Two things as I mentioned in the comments:
1) Remove k (and the entire k=k+1 line); replace with j. Also replace your Rows(i + 1).EntireRow.Delete with Rows(i + j).EntireRow.Delete.
2) Since you are deleting rows, lastrow is actually blank by the time you get there. Instead of i=2 to lastrow, make it do while Cells(i,12)<>"" or something. This is causing it to loop over a bunch of rows that are empty.
Also, you can do these type of rollups much easier with a PivotTable, or, as mentioned in the comments, with an SQL GROUP BY.
I have two rows of data, fracture pressure and depth. I have to code in vba to generate the polynomial (quadratic for this case) equation and then output the coefficients to the worksheet. I am using Linest and Index. For this two rows of data, I don't know how many datasets I have because I need to delete some noisy data first (the definition of noisy data is randomly so the number of datasets vary each time), so I can't use something like "A17:A80" in the linest function. However, it looks like the worksheet function in vba can't work for arrays.
Dim Frac_x, Frac_y As Range
Dim X
Set Frac_x = Range(Cells(17, 1), Cells(e - 1, 1))
Set Frac_y = Range(Cells(17, 7), Cells(e - 1, 7))
X= Application.WorksheetFunction.LinEst(Frac_y,Frac_x,{1,2})
Cells(3, 8).Value = Application.WorksheetFunction.Index(X, 1, 1)
Cells(4, 8).Value = Application.WorksheetFunction.Index(X, 1, 2)
Cells(5, 8).Value = Application.WorksheetFunction.Index(X, 1, 3)
In this code, e is defined in the previous code, (e-1) represents the total number of datasets. However, I keep getting { is a invalid character for the line: X= Application.WorksheetFunction.LinEst(Frac_y,Frac_x,{1,2})
Then I did some researches and modified the code to:
Dim Frac_x, Frac_y As Range
Dim X
Set Frac_x = Range(Cells(17, 1), Cells(e - 1, 1))
Set Frac_y = Range(Cells(17, 7), Cells(e - 1, 7))
X = Application.Evaluate("=linest(" & Frac_y & "," & Frac_x & "^ {1,2}))")
Cells(3, 8).Value = Application.WorksheetFunction.Index(X, 1, 1)
Cells(4, 8).Value = Application.WorksheetFunction.Index(X, 1, 2)
Cells(5, 8).Value = Application.WorksheetFunction.Index(X, 1, 3)
Then I keep getting Type Dismatch error for the line:
X = Application.Evaluate("=linest(" & Frac_y & "," & Frac_x & "^ {1,2}))")
I am sure the two ranges frac_y and frac_x their type matches. Anyone could help?
You are right, that Excel VBA can't do things like arrVariable^{1,2}. That must be done with loops over the array items.
But the Evaluate approach should work. But your formula string is not correct. To detect and avoid such incorrectness, I will ever concatenate such formula strings within a String variable first. Then I can simply check the variable's value.
Example, Values are in A17:A26 and G17:G26:
Sub test()
Dim Frac_x As Range, Frac_y As Range
Dim X
e = 27
With ActiveSheet
Set Frac_x = .Range(.Cells(17, 1), .Cells(e - 1, 1))
Set Frac_y = .Range(.Cells(17, 7), .Cells(e - 1, 7))
arrX = Frac_x
ReDim arrX2(1 To UBound(arrX), 1 To 2) As Double
For i = LBound(arrX) To UBound(arrX)
arrX2(i, 1) = arrX(i, 1)
arrX2(i, 2) = arrX(i, 1) * arrX(i, 1)
Next
X = Application.LinEst(Frac_y, arrX2)
'sFormula = "=LINEST(" & Frac_y.Address & "," & Frac_x.Address & "^{1,2})"
'X = Application.Evaluate(sFormula)
.Range(.Cells(3, 8), .Cells(5, 8)).Value = Application.Transpose(X)
End With
End Sub
Hints: Use Application.LinEst instead of Application.WorksheetFunction.LinEst. The latter will throw an error if the function cannot work while the first will return an error value instead. So the first will not interrupt the program as the latter will do.
When I run the program, nothing happens. I think it's because I am not using the right variable types or I am not doing variable and value assignment properly.
This is what I want the code to do:
For every cell from row 80, column 6 to row 90, column 6, I want j to be the INTEGER specified in that cell. For every column from 10 to 100, if the DATE in Cells(i,2) is the same as the DATE in Cells(1,k), then I want to set Cells(j, k) as the INTEGER found in Cells(j, 6).
Please help me correct this code.
Sub TestSub()
Dim i As Integer, i2 As Integer, i3 As Integer
Dim j As Integer, j2 As Integer, j3 As Integer
Dim k As Integer, k2 As Integer, k3 As Integer
For i = 81 To 95
j = Cells(i, 6) 'j becomes the row # of the equipment
For k = 8 To k = 115
If Cells(i, 2) = Cells(1, k) Then Cells(j, k) = Cells(j, 6) 'Cells(i,2)->NEXT PM DATE Cells(1,k)->CALENDER DATE (MM/1/YY)
Next k
Next i
For i2 = 97 To 105
j2 = Cells(i2, 6)
For k2 = 8 To k2 = 115
If Cells(i2, 2) = Cells(1, k2) Then Cells(j2 + 1, k2) = Cells(j2 + 1, 6)
Next k2
Next i2
For i3 = 107 To 121
j3 = Cells(i3, 6)
For k3 = 8 To k3 = 115
If Cells(i3, k3) = Cells(j3, 6) Then Cells(j3 + 2, k3) = Cells(j3 + 2, 6)
Next k3
Next i3
End Sub
Have to post a second answer as the asker changed entirely the code:
These lines will never work
For k = 8 To k = 115
For k2 = 8 To k2 = 115
For k3 = 8 To k3 = 115
Change to the correct format
For k = 8 To 115
For k2 = 8 To 115
For k3 = 8 To 115
Then try
The problem is you got confused because you used single-letter variable names and made a mistake in your code that is not easily identifiable. To correct the error, change this line:
If Cells(i, 2) = Cells(1, k) Then Cells(j, k) = Cells(j, 6)
To be this instead:
If Cells(i, 2) = Cells(1, k) Then Cells(j, k) = Cells(i, 6)
Notice the only difference is that instead of setting it to Cells(j, 6) it needs to be set to Cells(i, 6). This is a common mistake for new programmers, and is the exact reason that using descriptive variable names is good practice. It will prevent simple errors like this.
This is what your code is doing:
It compares the dates for each cell in range B80:B90 (rows 80 to 90) with the dates of cells in range J1:CV1 (columns 10 to 100)
If the dates compared are equal then it takes the value in the same row and column 6 (F). This value is then used to reference a row number and places that row number in the column that contains the same date.
The program is validating the dates in range B80:B90 with the dates in range J1:CV1 and for those found equal is updating the corresponding cell in the row determined by the corresponding value in the range F80:F90.
Let’s look at the following sample case, where the date in cell B80 equals the date in cell J1 and the value in cell F80 is 97.
Then the program will enter the value of cell F97 in cell J97
Dim i As Integer, j As Integer, k As Integer
For i = 80 To 90
If i = 89 Then Stop
j = Cells(i, 6)
For k = 10 To 100
'as per the sample case
'i = 80 ; j = 97 and k = 10
'date in cell(B80) = date in cell(J1)
'If Cells(i, 2) = Cells(1, k) Then Cells(j, k) = Cells(j, 6)
'then J97 = F97
'Replaced with:
If Cells(i, 2) = Cells(1, k) Then Cells(j, 6) = Cells(i, 6)
Next k: Next
Therefore, if it seems that the program is doing nothing and could not see any result is either because there are no equal dates in the ranges compared or because results are expected to be shown in the range J80:CV90 but the values in range F80:F90 are determining a different output range (i.e. the values in range F80:F90 are lower than 80 or higher than 90.
I asked for the values in range F80:F90 to be provided to validate the above.
So if the objective is:
If the dates are equal, then it takes the value in the same row and column 6 (F) and inserts that value into cells(j, 6)
Then replaced line
If Cells(i, 2) = Cells(1, k) Then Cells(j, k) = Cells(j, 6)
with line
If Cells(i, 2) = Cells(1, k) Then Cells(j, 6) = Cells(i, 6)
The value of j is the value in cell(i,6) as determined by the line:
j = Cells(i, 6)
Basically if the date in cell B80 is found in Range J1:CV1 then enters 73, value in cell F80 or Cell(i,6), into cell F73 or Cell(j,6).
I am new to VBA in excel. I have a range of data with 11 000 numbers. I want to calculate the average of first 60, then next 60 until the end. I did some programming but it isn't working. Can someone please help me with it?
Sub Hourlyaverage()
Dim i As Long, j As Long, k As Long, l As Long, m As Long
Sheets("DUT1_Test51_excel").Select
i = 3
j = 3
k = 63
Do While Cells(i, 12).Value <> ""
l = Cells(i, 12).Value
m = Cells(k, 12).Value
Cells(j, 20).Value = [Average (l : m)]
i = i + 60
j = j + 1
k = k + 60
Loop
End Sub
Look closely at what you're trying to do in this code:
l = Cells(i, 12).Value
m = Cells(k, 12).Value
Cells(j, 20).Value = [Average (l : m)]
You're assigning a "long" value to each of l and m and then calling them in the average function as if they were references to a cell.
I suggest that you add a range variable, assign the location of the data you want to average and use that as your function argument.
Something like:
Dim myRange as Range
'Loop code here
Set myRange = Range("L" & i & ":L" & k)
Cells(j, 20).Value = Application.WorksheetFunction.Average(myRange)
I wrote a macro to insert a row between cells when their values are different. I have 9 columns in my data and the data starts at row 2. I want my macro to check all the values down column 3 (also known as column "C") and as it goes through, if the value changes (i.e. 2, 2, 2, 3, 3) it will insert a row between the changed value (i.e. 2, 2, 2, INSERT ROW, 3, 3). The problem is, my macro is reading column 5(E) not 3(C). What is wrong with it, I can't figure it out! The reason I know this too is because I placed a msgbox to spit the value of the cell and it matches everything in column 5 but not 3. Here is my code:
Sub Dividers()
Dim DividerRange As Range, lastrow As Long, k As Integer, counter As Integer
lastrow = Range("C2").End(xlDown).Row
Set DividerRange = Range(Cells(2, 3), Cells(lastrow, 3))
counter = 0
For k = 2 To DividerRange.Count
MsgBox DividerRange(k + counter, 3).Value
If DividerRange(k + counter, 3).Value = DividerRange(k + counter - 1, 3).Value Then
DividerRange(k + counter, 3).EntireRow.Insert
counter = counter + 1
Else
End If
Next k
End Sub
DividerRange(k + counter, 3).Value is a relative reference. DividerRange is a range starting at C2, so when you ask for the (i,j)th cell, i.e. (i,3) you get something from column E where jth columns would be: (C = 1, D = 2, E = 3)
You can simplify it quite a lot, there's no need for the Range or Range count, or counter:
Sub Dividers()
Dim lastrow As Long, k As Integer
lastrow = Range("C2").End(xlDown).Row
For k = 2 To lastrow
If Cells(k, 3).Value <> Cells(k - 1, 3).Value Then
Cells(k, 3).EntireRow.Insert
'Now skip a row so we don't compare against the new empty row
k = k + 1
End If
Next k
End Sub