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
Related
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.
I have an Excel template that I am working on as a tool for our department, and it has multiple sheets that can be copied, and what it ultimately does, is compile data from the first few sheets to create a list of sheet goods to be produced in our manufacturing facility. Each line item consists of a quantity, and then a core material, and two faces. This list is a separate sheet, that can be copied to create many different lists all referencing data from the same first three sheets.
I need to be able to quickly, and in a somewhat automated process, create a secondary list from the data of the first list. The secondary list needs to tell give me a total of each unique core, face, and backer. Some of the backers are the same as the face, so those should be consolidated.
I have a macro already that can allow the user to select a range of data, and then it spits out a consolidated list with quantities and names. The problem is this only works for 3 columns of data, and uses the 3rd column as the name, and the first as the quantity. I haven't figured out how to get it to look to columns of data that are not exactly adjacent, or more than 3 columns.
I am much more comfortable with spreadsheet formulas, but I'm thinking a macro would be the best solution if I can figure it out, as the end users of this spreadsheet have limited knowledge of excel, and I don't want to rely on them memorizing a bunch of steps.
First List
Start of Second List
Here is the macro I have so far.
Sub Macro1()
Dim i, J, K, L, M, R1, R1F, C1F, Temp As Integer
Dim SemiFinalData(500, 2) As Variant
Dim FinalData(500, 2) As Variant
i = J = 0
Set InputData = Application.InputBox(prompt:="Select the full range of Data (Qty Through Description)", Type:=8)
R1 = InputData.Rows.Count 'Gets Data to Summarize and Counts the Number of Rows
For i = 1 To R1
If InputData(i, 3) <> "" Then
SemiFinalData(J, 0) = InputData(i, 1)
SemiFinalData(J, 1) = InputData(i, 2)
SemiFinalData(J, 2) = InputData(i, 3)
J = J + 1
End If
Next i 'Extracts Non-Blank Data into Array
M = 0
For i = 0 To J - 1 'Loops for each value in SemifinalData
L = 0
For K = 0 To J - 1 'Second loop for each value in SemifinalData
If SemiFinalData(i, 2) = FinalData(K, 2) Then 'Counter for Duplication Test
L = L + 1
End If
Next K
If L < 1 Then 'Tests for Duplication and Extracts Data to FinalData Array
FinalData(M, 1) = SemiFinalData(i, 1)
FinalData(M, 2) = SemiFinalData(i, 2)
M = M + 1
End If
Next i
For i = 0 To M - 1
Temp = 0
For K = 0 To J - 1
If FinalData(i, 2) = SemiFinalData(K, 2) Then
Temp = Temp + SemiFinalData(K, 0)
End If
Next K
FinalData(i, 0) = Temp
Next i
Set OutputData = Application.InputBox(prompt:="Select the first Cell of Output Range (for Qty)", Type:=8)
R1F = OutputData.Row
C1F = OutputData.Column 'Gets Row/Column for Start of Output Range
For K = 0 To 2
Cells(R1F, C1F + K).Select
For i = 0 To M - 1
Selection = FinalData(i, K)
ActiveCell.Offset(1, 0).Range("A1").Select 'Writes Data to Sheet
Next i
Next K
End Sub
Essentially I am struggling with the 3 types of data on the same row from the first list, and the best way to separate them onto their own line on the second sheet.
You may want to look at using
Worksheets().range().AdvancedFilter(....)
This could help you pick out the data that you are looking for much easier. Check the office vba reference for more details.
As a complete beginner to VBA Excel, I would like to be able to do the following:
I want to find the first value larger than 0 in a row, and then sum over the following 4 cells in the same row. So
Animal1 0 0 1 2 3 0 1
Animal2 3 3 0 1 4 2 0
Animal3 0 0 0 0 0 1 0
Results in
Animal1 7
Animal2 11
Animal3 1
Is this possible?
(Your problem description didn't match your examples. I interpreted the problem as one of summing the 4 elements in a row which begin with the first number which is greater than 0. If my interpretation is wrong -- the following code would need to be tweaked.)
You could do it with a user-defined function (i.e. a UDF -- a VBA function designed to be used as a spreadsheet function):
Function SumAfter(R As Range, n As Long) As Variant
'Sums the (at most) n elements beginning with the first occurence of
'a strictly positive number in the range R,
'which is assumed to be 1-dimensional.
'If all numbers are zero or negative -- returns a #VALUE! error
Dim i As Long, j As Long, m As Long
Dim total As Variant
m = R.Cells.Count
For i = 1 To m
If R.Cells(i).Value > 0 Then
For j = i To Application.Min(m, i + n - 1)
total = total + R.Cells(j)
Next j
SumAfter = total
Exit Function
End If
Next i
'error condition if you reach here
SumAfter = CVErr(xlErrValue)
End Function
If your sample data is in A1:H3 then putting the formula =SumAfter(B1:H1,4) in I1 and copying down will work as intended. Note that the code is slightly more general than your problem description. If you are going to use VBA, you might as well make your subs/functions as flexible as possible. Also note that if you are writing a UDF, it is a good idea to think of what type of error you want to return if the input violates expectations. See this for an excellent discussion (from Chip Pearson's site - which is an excellent resource for Excel VBA programmers).
ON EDIT: If you want the first cell greater than 0 added to the next 4 (for a total of 5 cells in the sum) then the function I gave works as is, but using =SumAfter(B1:H1,5) instead of =SumAfter(B1:H1,4).
This is the one of the variants of how you can achieve required result:
Sub test()
Dim cl As Range, cl2 As Range, k, Dic As Object, i%: i = 1
Set Dic = CreateObject("Scripting.Dictionary")
For Each cl In ActiveSheet.UsedRange.Columns(1).Cells
For Each cl2 In Range(Cells(cl.Row, 2), Cells(cl.Row, 8))
If cl2.Value2 > 0 Then
Dic.Add i, cl.Value2 & "|" & Application.Sum(Range(cl2, cl2.Offset(, 4)))
i = i + 1
Exit For
End If
Next cl2, cl
Workbooks.Add: i = 1
For Each k In Dic
Cells(i, "A").Value2 = Split(Dic(k), "|")(0)
Cells(i, "b").Value2 = CDec(Split(Dic(k), "|")(1))
i = i + 1
Next k
End Sub
Here is what I would use, I dont know any of the cell placement you have used so you will need to change that yourself.
Future reference this isnt a code writing site for you, if you are new to VBA i suggest doing simple stuff first, make a message box appear, use code to move to different cells, try a few if statments and/or loops. When your comftable with that start using varibles(Booleans, string , intergers and such) and you will see how far you can go. As i like to say , "if you can do it in excel, code can do it better"
If the code doesnt work or doesnt suit your needs then change it so it does, it worked for me when i used it but im not you nor do i have your spread sheet
paste it into your vba and use F8 to go through it step by step see how it works and if you want to use it.
Sub test()
[A1].Select ' assuming it starts in column A1
'loops till it reachs the end of the cells or till it hits a blank cell
Do Until ActiveCell.Value = ""
ActiveCell.Offset(0, 1).Select
'adds up the value of the cells going right and removes the previous cell to clean up
Do Until ActiveCell.Value = ""
x = x + ActiveCell.Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, -1).ClearContents
Loop
'goes back to the begining and ends tallyed up value
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 1).Value = x
'moves down one to next row
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Consider the following VBA MWE
Sub test()
Dim rng As Range
Set rng = Range("A:A, C:C")
Dim rRow As Range
For i = 1 To 5
Set rRow = Intersect(rng, rng.Cells(i, 1).EntireRow)
rRow.Value = 1
rRow.Cells(, 2).Value = 2
Next
End Sub
Which produces an output that looks like this
1 2 1
1 2 1
1 2 1
1 2 1
1 2 1
As we can see, the line rRow.Value = 1 sets the cells in the first and third column to 1. Now, I can't get my head around why the rRow.Cells(1,2) doesn't access the third column such that the output is
1 2
1 2
1 2
1 2
1 2
and leave the second column empty, since this appears to be what is happening in the line rRow.Value = 1. Can someone explain this logic to me?
EDIT:
Commenting out the rRow.Cells(,2).Value = 2 such that the code reads
Sub test()
Dim rng As Range
Set rng = Range("A:A, C:C")
Dim rRow As Range
For i = 1 To 5
Set rRow = Intersect(rng, rng.Cells(i, 1).EntireRow)
rRow.Value = 1
'rRow.Cells(, 2).Value = 2
Next
End Sub
yields the following output
1 1
1 1
1 1
1 1
1 1
where columns A and C are filled with ones, and column B is left alone.
Using the Range or Cells property of a Range object (rather than the more usual Worksheet), provides a reference to a range relative to the top left cell of the original range. It is not in any way restricted to cells within that original range.
Hence this:
Range("A1").Range("B2")
refers to the cell one column to the right and one row below A1. So does this:
Range("A1:A10").Range("B2")
Note that it still only refers to one cell, even though the original range was 10 cells. Cells works in exactly the same way (just as it does with a Worksheet parent). So this:
Range("A1").Cells(2, 2)
and this:
Range("A1:A10").Cells(2, 2)
both refer to B2.
Hi I am using VB to populate data in excel. In the sheet, the column G has many cells with same numbers(and they are repeated without following any pattern). First I would like to find which entries are not unique and then keep the first occurrence in the column & delete the entire rows where repetitions are encountered. Here's an example:
As can be seen from the image, in the column G, numbers 1000 & 2200 are repeated. So need to delete entire rows 3 and 6 (keeping rows 1 & 2 where 1000 & 2200 appear first).
Here's the code which I can't get to work:
Sub Dupli()
Dim i As Long, dic As Object, v As Object
dic = CreateObject("Scripting.Dictionary")
i = 1
For Each v In sheet.UsedRange.Rows
If dic.exists(v) Then sheet.Rows(v).EntireRow.Delete() Else dic.Add(v, i)
i = i + 1
Next v
End Sub
Try something like this. I don't think you need a dictionary (unless there is some other need for it elsewhere in your code). When deleting objects, it's usually necessary to iterate backwards over the collection. This method just uses the CountIf function to test whether the cell value in column G of a specific row occurs more than once in all of column G, and deletes the row if that condition is true.
Sub Dupli()
Dim i As Long
Dim cl as Range
i = 1
For i= sheet.UsedRange.Rows.Count to 1 Step -1
Set cl = sheet.Cells(i,7) '## Examine the cell in Column G
If Application.WorksheetFunction.CountIf(sheet.Range("G:G"),cl.Value) > 1 Then
sheet.Rows(i).EntireRow.Delete
Next
End Sub
Put this in H1:
=COUNTIF(G$1:G1;G1)
Fill down to end
Make an autofilter on column G
Filter out values of 1
Select the remaining rows by row header
Right click on row header > click Delete ...