I am trying to find the first four cells along a row that contain values and the type is Double. I want to add the values of the cells to an array and also locate the cells locations for future use. I need to work down 23 rows after as well. Some of the rows don't contain any values. The matrix starts with cell AB3
I've been trying to start with a For loop so I can work down the rows and then having a For loop inside that to create a new array every time I move to a new row.
The code I need looks something like this.
For i = 3 to 27
For j = 0 to 3
TIGA(j) = Range(Cells(i, j + 28), Cells(last cell)).Find(first
value and then the next three)
Again I need to work across from left to right in each row. First I need to add the first four values in a row to an array. Next I need to save the column number for each of the values because I need to know what column they're in later on in my code. After I get the information for one your I need to loop it down for the rest. The array with the values and any variable/array used for the cells location can be restarted every time the code loops through for the new row. Thank you!
Here's what's the data looks like.
I changed things up a bit, I think this should suffice:
Sub Test()
Dim TIGA As Variant, i As Long, j As Long, k As Long
ReDim TIGA(0 To 3)
For i = 3 To 27
k = 0
For j = 28 To 40
If Cells(i, j) <> "" Then
If IsNumeric(Cells(i, j)) = True And InStr(Cells(i, j), ".") > 0 Then 'make sure it's a double
TIGA(k) = Cells(i, j)
k = k + 1
If k = 3 Then
Exit For
End If
End If
End If
Next j
Next i
End Sub
Related
I have the need to automatic create report that is based on the dates and portfolios.
For example if I put 2 dates and 2 portfolios like this
The report should look like this:
So if we enter 3 dates and 4 portfolios the report should have 3 tables and each one has 4 portfolios...
I'm ok to do it manual but it is ideally to be automatic,(I think it can be done through VBA, but not quite sure about it) can you guys help? Thank you.
You have to to move your data from where is stored to the Project sheet.
I guess that the date doesn't make any different on the portfolio, isn't it?
If so, it's quite easy. I don't know how your data is stored, but let's guess it's equal as shown it your screenshot.
Option Base 1 'array will start at 1 instead of 0
Public Setting As Worksheet, ListPortfolios As Worksheet, Project As Worksheet
Public RangeSelectDates As Range, RangeSelectPortfolios As Range, RowOfCodePortfolios As Range
Public ArraySelectDates(), ArraySelectPortfolios(), ArrayOfCodePortfolios(), ArrayPortfolio(), ArrayProject()
Public PortfolioCode$
Dim i%, j%, k%, r%, c%
Sub Automate()
Set Setting = Worksheets("Setting")
Set ListPortfolios = Worksheets("ListPortfolios")
Set Project = Worksheets("Project")
'First, read the portfolio code and dates to import and store in array
With Setting
Set RangeSelectDates = .Cells(4, 5).CurrentRegion
Set RangeSelectPortfolios = .Cells(4, 8).CurrentRegion
End With
ArraySelectDates = RangeSelectDates
ArraySelectPortfolios = RangeSelectPortfolios 'store the range in a Array
ReDim ArrayProject(1 To 24, 1 To 1)
'Now, create an array with the names of the portfolios where you have stored them. I don't know how your data is stored.
'I assume you've got it as the Project sheet result it's shown and also at "ListPortfolios" sheet
With ListPortfolios
Set RowOfCodePortfolios = .Rows(5)
End With
ArrayOfCodePortfolios = RowOfCodePortfolios 'store the row in a Array
k = 0 'means no value is found
For i = LBound(ArraySelectPortfolios) To UBound(ArraySelectPortfolios) 'Navigate to all the Portfolios Selected
'the portfolio codes are stored in the "second column" of the array, say PortfolioCode is the name of the portfolio
PortfolioCode = ArraySelectPortfolios(i, 2)
For j = LBound(Application.Transpose(ArrayOfCodePortfolios)) To UBound(Application.Transpose(ArrayOfCodePortfolios)) 'now navigate to where your portfolios are stored
If ArrayOfCodePortfolios(1, j) = PortfolioCode Then 'if match, create a new array with the whole portfolio
With ListPortfolios
ArrayPortfolio = .Range(.Cells(1, j), .Cells(24, j + 2)) 'I don't know the size of your data. I assume that the first column is the same of where the portfoliocode is stored and its size is 24 rows x 3 columns
End With
'now, copy it to the Project Portfolio
ReDim Preserve ArrayProject(1 To 24, 1 To 3 + k * 3)
For r = 1 To 24 'from the r (row) one to 24th. I don't know how your data is stored
For c = 1 To 3 'from the column 1 to the 3rd of each portfolio
ArrayProject(r, c + k * 3) = ArrayPortfolio(r, c) 'built the result for each portfolio found
Next c
Next r
k = k + 1 'one value is found, let's go for the next one if so
End If
Next j
Next i
If k <> 0 Then 'if any value is found then
For i = 1 To UBound(ArraySelectDates) 'let's place the date and print to the excel
ArrayProject(2, 1) = ArraySelectDates(i, 2) 'paste the date into the array
With Project
.Range(.Cells(1, 4 + 1 + (i - 1) * k), .Cells(24, UBound(Application.Transpose(ArrayProject)) + 3 + (i - 1) * k)) = ArrayProject 'print the array
'1+(i-1)*k is the first column + which date are we copying times portfolio codes found
End With
Next i
End If
End Sub
There's no error handling, either if there aren't input values may crash. But first, make it work
I'm trying to solve a problem in VBA and after a long time of browsing the web for solutions, I really hope someone is able to help me.
It's actually not a very hard task, but with very little programming and VBA knowledge as a new learner, I hope I can find a useful tip or solution with the help of the community.
So my problem is as follows:
I have a table with 3 columns, the first is filled with a number to use as an ID. Column 2 and 3 have different values that needs to be compared:
What I'd like to do is select the range of column rows of column 2 and 3 based on the same ID. Once I have selected the relevant ranges of the columns, I want to compare if one name of column 2 matches one name of column 3.
So there is no need to have all names of the desired column ranges to match. One name match is enough. If a name matches, it should automatically fill in a new column "result" with 1 for match (0 for no match).
Do you have an idea, how I can select specific cells of a column based on an identifier?
Dim ID_counter As Long
ID_counter = 1
If Cell.Value = ID_counter IN Range("Column1")
Then Range("Column2").Select
AND Range("Column3").Select
WHERE ID_counter is the same
In Column4 (If one Cell.Value IN Range("Column2-X:Column2-Y")
IS IDENTICAL TO Range("Column3-X:Column3-Y"), return 1, else return 0
End Sub
Many thanks in advance for your help!
This works for your example so perhaps you can generalise it. The formula in D2 is
=IF(A2=A1,"",MAX(IF($A$2:$A$10=A2,COUNTIF($B$2:$B$10,$C$2:$C$10))))
and is an array formula so must be confirmed with CTRL, SHIFT and ENTER.
Array alternative via Match() function
This approach compares the string items of columns B and C by passing two arrays (named b,c) as arguments (c.f. section [1]):
chk = Application.Match(b, c, 0)
The resulting chk array reflects all findings of the first array's items via (1-based) position indices of corresponding items in the second array.
Non-findings return an Error 2042 value (c.f. section [2]b)); assumption is made that data are grouped by id.
Sub OneFindingPerId()
'[0]get data
Dim data: data = Sheet1.Range("A1:D10") ' << project's sheet Code(Name)
Dim b: b = Application.Index(data, 0, 2) ' 2nd column (B)
Dim c: c = Application.Index(data, 0, 3) ' 3rd column (C)
'[1]get position indices of identic strings via Match() function
Dim chk: chk = Application.Match(b, c, 0) ' found row nums of a items in b
'[2]loop found position indices (i.e. no error 2042)
Dim i As Long
For i = 2 To UBound(chk) ' omit header row
'a) define start index of new id and initialize result with 0
If data(i, 1) <> data(i - 1, 1) Then
Dim newId As Long: newId = i
data(newId, 4) = 0
End If
'b) check if found row index corresponds to same id
If Not IsError(chk(i, 1)) Then ' omit error 2042 values
If data(chk(i, 1), 1) = data(i, 1) Then ' same ids?
If data(newId, 4) = 0 Then data(newId, 4) = 1 ' ~> result One if first occurrence
End If
End If
Next i
'[3]write results
Sheet1.Range("A1").Resize(UBound(data), UBound(data, 2)) = data
End Sub
First enter this user defined function in a standard module:
Public Function zool(r1, r2, r3) As Integer
Dim i As Long, v1 As Long, v2 As String
Dim top As Long, bottom As Long
zool = 0
v1 = r1.Value
top = r1.Row
' determine limits to check
For i = top To 9999
If v1 <> r1.Offset(i - top, 0).Value Then
Exit For
End If
Next i
bottom = i - 1
For i = top To bottom
v2 = Cells(i, "B").Value
If v2 <> "" Then
For j = top To bottom
If v2 = Cells(j, "C").Value Then zool = 1
Next j
End If
Next i
End Function
Then in D2 enter:
=IF(OR(A2="",A2=A1),"",zool(A2,B2,C2))
and copy downwards:
(this assumes that the data has been sorted or organized by ID first)
I run a performance database and have gotten stuck with a way to track repeat offenders.
In a Results sheet is all the data, I want to create a macro that goes through the results, filters column C to each staff number and count how many times they have a "Fail" result in column D.
If they have a count of 2 or above I want the sheet to copy their name in column B and staff no in column c to the first available line in a different sheet called "Flagged" with the fail count in a 3rd column.
My data runs from rows b8 to b10008 and I have 300 staff who could be assessed
Thanks in advance!
Set up your source data as a table (Ctrl+T with cell in range selected). Add a helper column with the formula:
=SUMPRODUCT(--([Fail/Pass]="FAIL"),--([Staff No]=[#[Staff No]]))>=2=SUMPRODUCT(--(D:D="FAIL"),--(C:C=[#[Staff No]]))>=2
Create your pivottable, Alt+N+V, using compact report layout, and add your helper column to the page field and filter on True. Add name and staff No to the row fields and remove subtotals.
As it is an Excel table you can add more rows and the formula will autofill down. You then just refresh the pivottable to update your flagged list.
Data:
Fields:
Compact design layout and no subtotals.
I would recommend to make use of arrays and loop your data that way, it should be nearly instant (comparing to looping in the sheet itself).
Keep in mind this is not fully tested, but it should get you pretty close to what you are trying to achieve:
Sub flagged()
Dim arrData As Variant, arrFails As Variant
Dim failCnt As Long, i As Long, j As Long, x As Long, lastRow As Long
Dim shResults As Worksheet, shFails As Worksheet
Set shResults = ActiveWorkbook.Sheets("Results")
Set shFlagged = ActiveWorkbook.Sheets("Flagged")
ReDim arrFails(0 To 300, 0 To 2)
arrData = shResults.Range("B8:D10008").Value
For i = LBound(arrData) To UBound(arrData)
For j = LBound(arrData) To UBound(arrData)
If arrData(i, 2) = arrData(j, 2) Then
If arrData(i, 3) = "FAIL" Then
failCnt = failCnt + 1
End If
If failCnt >= 2 Then
arrFails(x, 0) = arrData(i, 1)
arrFails(x, 1) = arrData(i, 2)
arrFails(x, 2) = failCnt
x = x + 1
End If
End If
Next j
failCnt = 0
Next i
For i = LBound(arrFails) To UBound(arrFails)
If arrFails(i, 0) <> "" Then
lastRow = shFlagged.Cells(1, j).End(xlDown).Row
For j = 1 To 3
shFlagged.Cells(lastRow + 1, j) = arrFails(i, j)
Next j
End If
Next i
End Sub
EDIT: changed the size of the dimension to accommodate 3 columns. Also I've initially done this to look for sorted data by staff number, but given is not that much data, that doesn't matter much, so I've edited out the code accordingly.
I am new to VB and am having trouble getting a good grasp on the syntax of nested loops. For example:
For N = 8 To 22
For M = 4 To 19
If Cells(N, 3).Value >= 0 Then
Cells(M, 35).Value = 1
Else
Cells(M, 35).Value = 2
End If
Next M
Next N
I want this loop to check one column of cells and IF a cell contains a 0 or positive number it should return "1" in the other specified column. Otherwise, it should return a "2".
Unfortunately this loop currently is returning (ELSE) "2" in every cell of the new column. Any explanation of what I am doing wrong?
Nested loops like this operate by repeating the inner cycle from start to finish every time the outer cycle goes through one step. So for each N, every row M will have its cell in column 35 set to 1 or 2 (all the same) based on the value at row N and column 3. So in this case, the last row N must have a negative number or be missing, which sets every one of the output column cells to "2".
What I suspect you want is something more like this:
For N = 8 To 22
If Cells(N, 3) >= 0 Then
Cells(N - 4, 35) = 1
Else
Cells(N - 4, 35) = 2
End If
Next N
Note that there seems to be an off-by-one error in your original code as well, in that N goes over 15 rows, but M goes over 16 rows. Also, because .Value is the default property, you can leave it out.
Bonus: Generally speaking, you'll want something with fewer magic numbers, like this:
Option Explicit
Public Sub DoSomething()
Const ColTest As Integer = 3, ColResult As Integer = 35, DRowResult As Integer = -4
Const RowStart As Integer = 8, RowEnd As Integer = 22
Dim Row As Integer
For Row = RowStart To RowEnd
If Cells(Row, ColTest) >= 0 Then
Cells(Row + DRowResult, ColResult) = 1
Else
Cells(Row + DRowResult, ColResult) = 2
End If
Next Row
End Sub
Then, if you need to generalize it to work on different areas (by switching the constants to parameters), change where you've hardcoded it to work, or whatever else, it's simple to fix it at the top, once, and be sure you've got everything. It's also easier to understand in many cases. And, of course, Option Explicit is just good in general. (D in the constant names stands for delta/difference.)
I want to calculate a moving average of the last, say 20, numbers of a column. A problem is that some of the cells of the column may be empty, they should be ignored. Example:
A
175
154
188
145
155
167
201
A moving average of the last three would be (155+167+201)/3. I've tried to implement this using average, offset, index, but I simply don't know how. I'm a little bit familiar with macros, so such a solution would work fine: =MovingAverage(A1;3)
Thanks for any tips or solutions!
{=SUM(($A$1:A9)*(ROW($A$1:A9)>LARGE((ROW($A$1:A9))*(NOT(ISBLANK($A$1:A9))),3+1)))/3}
Enter this with control+shift+enter to make it an array formula. This will find the latest three values. If you want more or less, change the two instances of '3' in the formula to whatever you want.
LARGE((ROW($A$1:A9))*(NOT(ISBLANK($A$1:A9))),3+1)
This part returns the 4th highest row number of all the cells that have a value, or 5 in your example because rows 6, 8, and 9 are the 1st through 3rd highest rows with a value.
(ROW($A$1:A9)>LARGE((ROW($A$1:A9))*(NOT(ISBLANK($A$1:A9))),3+1))
This part returns 9 TRUEs or FALSEs based on whether the row number is larger than the 4th largest.
($A$1:A9)*(ROW($A$1:A9)>LARGE((ROW($A$1:A9))*(NOT(ISBLANK($A$1:A9))),3+1))
This multiplies the values in A1:A9 by those 9 TRUEs or FALSEs. TRUEs are converted to 1 and FALSEs to zero. This leaves a SUM function like this
=SUM({0;0;0;0;0;155;0;167;201})/3
Because all the values above 155 don't satisfy the row number criterion, the get multiplied by zero.
If you are going to use a UDF it will only recalculate correctly when you change the data if the parameters include all the range of data you want to handle.
Here is a moving average UDF that handles entire columns and contains some error handling. You can call it using by entering the formula =MovingAverage(A:A,3) into a cell.
Function MovingAverage(theRange As Range, LastN As Long) As Variant
Dim vArr As Variant
Dim j As Long
Dim nFound As Long
Dim dSum As Double
On Error GoTo Fail
MovingAverage = CVErr(xlErrNA)
'
' handle entire column reference
'
vArr = Intersect(Application.Caller.Parent.UsedRange, theRange).Value2
If IsArray(vArr) And LastN > 0 Then
For j = UBound(vArr) To 1 Step -1
' skip empty/uncalculated
If Not IsEmpty(vArr(j, 1)) Then
' look for valid numbers
If IsNumeric(vArr(j, 1)) Then
If Len(Trim(CStr(vArr(j, 1)))) > 0 Then
nFound = nFound + 1
If nFound <= LastN Then
dSum = dSum + CDbl(vArr(j, 1))
Else
Exit For
End If
End If
End If
End If
Next j
If nFound >= LastN Then MovingAverage = dSum / LastN
End If
Exit Function
Fail:
MovingAverage = CVErr(xlErrNA)
End Function
Just a quick solution:
Supposing your numbers are on the cells A2:A10, put in B10 the following formula:
=IF(COUNT(A8:A10)=3,AVERAGE(A8:A10),IF(COUNT(A7:A10)=3,AVERAGE(A7:A10),"too many blanks"))
Dragging up the formula you get the moving average
If there is the possibility of two consecutive blank you could nest another if, more than that and this solution became too complicated
I have written a short script in VBA. Hopefull it does what you want. Here you are:
Function MovingAverage(ByVal r As String, ByVal i As Integer) As Double
Dim rng As Range, counter As Long, j As Integer, tmp As Double
Set rng = Range(r)
counter = 360
j = 0
tmp = 0
While j < i + 1 And counter > 0
If Len(rng.Offset(j, 0)) > 0 Then
tmp = tmp + rng.Offset(j, 0).Value
End If
j = j + 1
counter = counter - 1
Wend
MovingAverage = CDbl(tmp / i)
End Function
1) I have set limit to 360 cells. It means that the script will not look for more than 360 cells. If you want to change it then change the initial value of counter.
2) The script returns not rounded average. Change the last row to
MovingAverage = Round(CDbl(tmp / i),2)
3) The use is just like you wanted, so just type =MovingAverage("a1";3) into the cell.
Any comments are welcome.