Average the last 6 records entered within the row - vba

So I've made an Average/Offset formula that averages the last 6 records it sees. For example if I'm working with cells A1 to J1, and I enter values in A1 to H1, it will average values from C1 to H1. And if I add a value in I1, it will average D1 to I1. See the formula below:
AVERAGE(OFFSET(A1,0,COUNT(A1:J1)-6,1,6))
AVERAGE(OFFSET(first cell, COUNT(entire range)-N,0,N,1))
Here's an example: The average should be 3.5
A B C D E F G H I J
row 1: 4 2 3 4 5 5 2
The problem with the offset formula is that if there's a black cell between A1 to J1, it miscalculates because it believes the last data was at the break (if that makes sense). I'm looking for an alternative formula that reads from the right-most value from the selected array (since I'll be adding values to the right all the time).

To get the last 6 values in a row, excluding all blanks:
=AVERAGE(INDEX(135:135,AGGREGATE(14,6,COLUMN(H135:AA135)/(H135:AA135<>""),6)):INDEX(135:135,AGGREGATE(14,6,COLUMN(H135:AA135)/(H135:AA135<>""),1)))

This small UDF() should work for any row or column:
Option Base 1
Public Function SuperAverage(rng As Range, N As Long) As Double
Dim RngCnt As Long, i As Long, Zum As Double, j As Long
Dim ary() As Double
ReDim ary(1)
j = 1
RngCnt = rng.Count
For i = RngCnt To 1 Step -1
If rng(i).Value <> "" Then
ary(j) = rng(i).Value
If j = N Then Exit For
ReDim Preserve ary(j + 1)
j = j + 1
End If
Next i
SuperAverage = Application.WorksheetFunction.Average(ary)
End Function
For example:
The first argument is the range and the second argument is the item count.

Related

For loop and If statement Excel VBA

I would really appreciate if you could help me out with this problem. I am trying to get vba to provide me all the numbers in increment of 1 from 1 to a value in cell G1 and populate it into column C. Afterwards, I want vba to check each cell in column C starting from C1 to see if the value is greater than a number and to populate into the column next to it( Column D1 onwards )
For example, cell G1 has the number 5.
So, I should see the following in column c , which are the 1, 2,3,4,5 and in column D I should see only the value for cells greater than say 3. So that means only the value 4, and 5 is populated in columnn D.
I would appreciate any help as I am quite new to VBA and am trying to get a hang of it.
Thnx.
Give this a try:
Sub elyas()
Dim i As Long, MagicNumber As Long
Dim k As Long
MagicNumber = 3
k = 1
For i = 1 To [G1]
Cells(i, "C").Value = i
If i > MagicNumber Then
Cells(k, "D").Value = i
k = k + 1
End If
Next i
End Sub

Removing loops to make my VBA macro able to run on more data

in my data there are more than a thousand different six digit numbers that are reoccurring in no specific pattern. I need to find all six digit codes that exist in column A and for each number. For example 123456, then find summarize the value in column B for every row that has 123456 in column A. My code is not very effective but the runtime is not a problem if I run with only 10 rows. However, in the real data sheet there are 80 000 rows and my code will take to much time. Can someone help me edit my code but removing certain loops within loops or some stop conditions. I'm new to VBA and can't do it myself in the limited time I have.
Sub Test2()
Dim summa As Long
Dim x As Long
Dim condition As Boolean
Dim lRows As Long
Dim k1 As Integer
Dim i As Long
x = 1
Worksheets("Sheet1").Activate
For i = 100000 To 999999
k1 = 1
lRows = 10
condition = False
While k1 <= lRows
If Cells(k1, "A").Value = i Then
condition = True
End If
k1 = k1 + 1
Wend
If condition = True Then
Cells(x, "F").Value = Application.SumIf(Range("A:A"), CStr(i), Range("B:B"))
Cells(x, "E").Value = i
x = x + 1
End If
Next i
MsgBox "Done"
End Sub
You don't need VBA for this task. Follow these steps.
Insert a blank column C in a copy of the original data sheet.
Insert a SUMIF formula, like =SUMIF(A:A, A2, B:B) in C2 and copy all the way down.
Now all items 123456 will have the same total in column C
Copy column C and Paste Values (to replace the formulas with their values).
Delete column B.
Remove duplicates.

Generate table by VBA in Excel

I'm new in VBA. I hope that this is not a difficult question for you.My problem:
I have TEXT in column A and NUMBER in column B. Like this:
Column A Column B
TEXT 1 3
TEXT 2 2
TEXT 3 3
..... ...
I need to auto-generate a table in other sheet which has two columns. First contains the text which repeats n times (NUMBER in column B) and then the next text from Column A. In the second column of this table I need number from 1 to NUMBER. like this:
Column A Column B
TEXT 1 1
TEXT 1 2
TEXT 1 3
TEXT 2 1
TEXT 2 2
TEXT 3 1
TEXT 3 2
TEXT 3 3
.... ....
Then I have to post-process this table, but I know how to make it. I don't know how to generate the table.
Expanding on my comment:
Sub MakeTable()
Dim i As Long, j As Long, k As Long, m As Long, n As Long
Dim t As String
Dim ws As Worksheet
Sheets(1).Activate
Set ws = Sheets(2)
n = Cells(Rows.Count, 1).End(xlUp).Row()
k = 1
For i = 1 To n
t = Cells(i, 1).Value
m = Cells(i, 2).Value
For j = 1 To m
ws.Cells(k, 1).Value = t
ws.Cells(k, 2).Value = j
k = k + 1
Next j
Next i
End Sub
This assumes that the original data is in Sheet1 and you are transferring it to Sheet2, and that the data begins in row 1. Adjust accordingly if those assumptions are false. The way I determine the last cell in column A that has data is an important idiom in Excel VBA and should be mastered.

Excel: Reference non-zero cells

I'm trying to list 50 rows x 8 columns of cells (defined 'allhazards') into one column
However each cell in myhazards is referencing other sheets and contain 0's where there is no text to be referenced.
When I list the data in 'allhazards' in a single column using this formula:
=INDEX(allhazards,1+INT((ROW($A1)-1)/COLUMNS(allhazards)),MOD(ROW($A1)-1+COLUMNS(allhazards),COLUMNS(allhazards))+1)
(then drag down the column to get all of the cells from 'allhazards')
How do I implement this:
if cell in 'allhazards' is 0, do not reference this cell, move to next row
...then reference next row's columns until cell is 0, then move to next row
...keep doing this until there are no rows left to be referenced
eg. if 'allhazards' contained these cells (eg. 2 rows x 8 columns):
hello how are 0 0 0 0 0
good 0 0 0 0 0 0 0
It should produce this when dragging down the formula:
hello
how
are
good
but not this:
hello
how
are
0
0
0
0
0
good
0
0
0
0
0
0
0
I created a UDF for your situation. Please place the following procedure in a standard code module.
Public Function MATRIX2VECTOR(r As Range)
Dim i&, j&, k&, v, m, o
v = r
ReDim o(1 To Application.Caller.Rows.Count, 1 To 1)
For i = 1 To UBound(v, 1)
For j = 1 To UBound(v, 2)
m = v(i, j)
If Len(m) Then
If m <> 0 Then
k = k + 1
o(k, 1) = v(i, j)
End If
End If
Next
Next
For k = k + 1 To UBound(o): o(k, 1) = "": Next
MATRIX2VECTOR = o
End Function
Now you can call it in a formula from the worksheet just like any of the built-in functions.
1
Select a vertical range of cells tall enough to accommodate the transposed data.
2
Click in the Formula Bar at the top of Excel.
3
Enter this formula:
=MATRIX2VECTOR(allhazards)
4
This is an array formula and must be confirmed with Ctrl+Shift+Enter.
If you're interested in a non-VBA solution:
=IF(ROWS($1:1)>COUNTIF(allhazards,"<>0"),"",INDIRECT(TEXT(AGGREGATE(15,6,(10^5*ROW(allhazards)+COLUMN(allhazards))/(allhazards<>0),ROWS($1:1)),"R0C00000"),0))
Copy down as required.
This will be more efficient if you use a single helper cell to store the number of non-zero entries in allhazards, and also store the ROW/COLUMN portion as a Defined Name. For example, if you put:
=COUNTIF(allhazards,"<>0")
in e.g. J1, and define, in Name Manager, Arry1 as:
=10^5*ROW(allhazards)+COLUMN(allhazards)
then the main formula becomes:
=IF(ROWS($1:1)>$J$1,"",INDIRECT(TEXT(AGGREGATE(15,6,Arry1/(allhazards<>0),ROWS($1:1)),"R0C00000"),0))
If your data is in a different sheet to that housing the results, simply include the sheet name containing the data, viz:
=IF(ROWS($1:1)>$J$1,"",INDIRECT("'YourSheetName'!"&TEXT(AGGREGATE(15,6,Arry1/(allhazards<>0),ROWS($1:1)),"R0C00000"),0))
Regards

Is it possible to give the count of maximum columns used by a particular row(s)

I have a Excel matrix as below:
PID# T1 T2 T3 T4 T5 T6 T7
11 1 1
14 1 1 1
21 1 1
41 1 1 1 1
71 1
88 1 1 1
PID# is nothing but the processes, all the processes has been composed of multiple tasks. But it is not mandatory that all processes should use all the T1 - T5 tasks. In such a scenario is it possible to get the PID# which used maximum tasks. 1 used to indicate that a task has been used or not. here the PID# 41 and 88 used maximum tasks say it is 5. I need only the maximum used column count and any of the row# which used that number of columns.
NOTE
here i have used 1 to tell there is data,but in reality there are different types of data. I need to find out which row used maximum columns.But one thing if any cells for a row is blank and it is to the left,should be in the count. say for example --
<> 1 <> 1 gives the count as 4
<> <> 1 <> will give the count as 3
1 1 <> will give the count as 2 ' here I used <> used to represent the no values
EDIT
Option Explicit
Dim ArrayListTaskDetails : Set ArrayListTaskDetails = CreateObject("System.Collections.ArrayList")
Dim i,colcount
i=2
Do while i < = objExcel1.Application.WorksheetFunction.CountA(ob.Rows(1))
colcount=objExcel1.Application.WorksheetFunction.CountA(ob.Rows(i))
ArrayListTaskDetails.Add(colcount)
i=i+1
Loop
ArrayListTaskDetails.Sort()
i=ArrayListTaskDetails.Count
MsgBox("HighestColumnNumner:" & ArrayListTaskDetails(i-1))
Problem:
I can't count the blank columns for rows which don't have the contiguous value. Thus count is not produced by me correctly.
EDIT1
Here the problem is still i can't count the left blank cells if any,as those are also to be considered as used column,in which other rows can have values.Thus need to find out the the right most column which has been used by a row after which no columns has been used by any rows. Hope I am able to clear what I am looking for:
Option Explicit
Dim objExcel1
Dim strPathExcel1
Dim objSheet1,objWB,ColCount
Dim ArrayListTaskDetails : Set ArrayListTaskDetails = CreateObject("System.Collections.ArrayList")
Set objExcel1 = CreateObject("Excel.Application")
strPathExcel1 = "D:\AravoVB\.xlsx"
Set objWB = objExcel1.Workbooks.open(strPathExcel1)
Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)
Do Untill count > objExcel1.Application.WorksheetFunction.CountA(objSheet1.Rows(1))
Range = objSheet1.("count:count")
ColCount=objExcel1.Application.WorksheetFunction.CountIf(Range,<> "")
ArrayListTaskDetails.Add(ColCount)
Loop
ArrayListTaskDetails.Sort()
MsgBox(ArrayListTaskDetails(ArrayListTaskDetails.Count - 1))
Thanks,
Still not convinced why Vikas answer is not working for you. Try this code please. It highlights the last max value. Only flaw is that it doesn't track all the PID that has same max value. I could improve the code if you need that as well.
Code:
Option Explicit
Sub getRealUsedColumns()
Dim rngInput As Range
Dim arrInput As Variant, arrRowTotal As Variant
Dim i As Integer, j As Integer, counter As Integer, iTemp As Integer
Dim iPID As Integer, maxRowNum As Integer
arrInput = Application.WorksheetFunction.Transpose(Sheets(3).Range("B3:I8").Value2)
ReDim arrRowTotal(LBound(arrInput, 2) To UBound(arrInput, 2))
For i = LBound(arrInput, 2) To UBound(arrInput, 2)
counter = 0
For j = LBound(arrInput) + 1 To UBound(arrInput)
If arrInput(j, i) <> "" Or Not IsEmpty(arrInput(j, i)) Then
counter = counter + 1
End If
Next j
'-- most recent max value (if you have two of the same, this doens't catch)
'-- you need to save in a proper array to catch multiple PIDs with same max value
If iTemp <= counter Then
iTemp = counter
iPID = arrInput(1, i)
maxRowNum = i
End If
arrRowTotal(i) = counter
Next i
'-- Row total into the sheet output
Sheets(3).Range("J3").Resize(UBound(arrRowTotal)) = _
Application.WorksheetFunction.Transpose(arrRowTotal)
'-- highlight the max total row.
With Sheets(3).Range("B3").Offset(maxRowNum - 1, 0).Resize(1, UBound(arrInput, 1) + 1)
.Interior.Color = 200
End With
End Sub
Results:
Excel is very powerful in calculating Matrix. I would use the Excel Formula instead of Code in order to calculate it. I would add a column in the right, which would add the total number of tasks used by a process, as shown in the matrix below.
A B C D E F G
1 PID T1 T2 T3 T4 T5 Total
2 #11 1 1
3 #14 1 1 1 3
4 #21 1 1 1 1 1 5
5 #41 1 1 2
Then I will write two Array Formulas to calculate the maximum number of tasks used by a process and the name of that process.
Formula to calculate maximum tasks used in the example: =SUM(IF($G$2:$G$5=MAX($G$2:$G$5),G2:G5,0))
Formula to find the pricess which used the maximum tasks:
=OFFSET(A1,SUM(IF($G$2:$G$5=MAX($G$2:$G$5),ROW(G2:G5)-1,0)),0,1,1)
Please note that I had mentioned that I used Array formulas. In order to add array formula in Excel, you need to enter formula and then press "Ctrl+Shift+Enter" to make that formula an array formula.
Hope this helps.
Vikas B
-----------------EDIT-----------------------------------------------------
Adding the code here. I just used the sample, as show in matrix and produced the correct result.
Sub FindMax()
'assuming column 1 is the task ID and Row one has the headings.
Const LastColumn As Integer = 7 ' you can use xl end to get the last used column in the range
Const LastRow As Integer = 5
Dim rowCounter As Integer
Dim prevValue As Integer
Dim rngToTotal As Range
Dim sht As Worksheet
Dim maxRowName As String
Dim value As Integer
Dim maxValue As Integer
Set sht = ActiveSheet
For rowCounter = 2 To LastRow
Set rngToTotal = sht.Range(sht.Cells(rowCounter, 2), sht.Cells(rowCounter, LastColumn))
value = WorksheetFunction.Sum(rngToTotal)
If value > prevValue Then
maxRowName = sht.Cells(rowCounter, 1).value
maxValue = value
End If
prevValue = value
Next rowCounter
MsgBox "Process name " & maxRowName & " = " & maxValue
End Sub