Excel 2010 VBA - Calculate average based on name in Column A - vba

I'm new to excel VBA and I've been searching for a few hours and I can't figure this out. The R1C1 method is confusing me (I have been researching it), but this is how the record macro started the formula.
I have names in Column 1 and I need to average all the values in Column 4, but only for each Name, then repeat for the other names. I want the output in Column 5, Offset(0,1) from "Buy Day". I have been searching online and putting together some code from other examples I found, but I still can't get it. Any help would be appreciated! Thanks!
Example Sheet (note: is there any way to insert a table?)
Desired Outcome
Code (so far)
Dim LastRow2 As Long
Dim rng As Range
Dim r1 As Long, r2 As Long
Dim lNoRows As Long
LastRow2 = Sheets("Sheet2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set rng = Sheets("Sheet2").Range("A2:D" & LastRow2)
lNoRows = rng.Rows.Count
For r1 = 1 To lNoRows
If rng(r1, 4) = "Buy Day" Then
For r2 = 1 To lNoRows
If rng(r1, 1) = rng(r2, 1) And r1 = r2 Then _
rng(r2, 5).FormulaR1C1 = "=AVERAGE(R" & r2 & "C[-1]:R" & r2 & "C[-1])"
Next r2
End If
Next r1
Range("K9").FormulaR1C1 = "=Average(R[-7]C[-7]:R[1]C[-7])"
Basically what I'm trying to recreate in the top Average formula is what's in the bottom one, except dynamically, not specific to one cell. When it runs right now it just pulls in one value, it doesn't do any averaging. In cell E6 it shows =AVERAGE(D$5:D$5).

I see you've understood that you've mixed up rows and columns in your question description. So I'll just show you the idiomatic Excel way of doing what you want:
You'll find the Subtotal tool in Data > Outline > Subtotal.

I haven't answered a question twice before, but I feel that even though my first answer is still valid, this one is better. You will want this formula in your cell E2, and then copy down for the entire column:
=IF(D2 = "Buy Day", AVERAGEIF($A:$A, A2, $D:$D), "")
It takes the average of only those numbers in column D whose corresponding symbol in column A is the same as the symbol in the 'Buy Day' row. It will give you your desired outcome.

Related

Simplifying complex excel formula with VBA

I have a macro that is generally slow due to overuse of LOOKUP formulas. I want to insert some VBA variables to speed these up. I am currently working on speeding up the formula below:in Excel:
=IF(ISNA(MATCH(A2,Summary!B:B,0)),"n",I2-((I2/LOOKUP(2,1/(I:I<>""),I:I))*VLOOKUP(A2,Summary!$G$10:$H$902,2,FALSE)))
in VBA:
"=IF(ISNA(MATCH(RC[-9],Summary!C[-8],0)),""n"",RC[-1]-((RC[-1]/LOOKUP(2,1/(C[-1]<>""""),C[-1]))*VLOOKUP(RC[-9],Summary!R10C7:R902C8,2,FALSE)))"
The portion I need to replace is LOOKUP(2,1/(C[-1]<>""""),C[-1]). All this does is reference the last non empty cell in column I. Right now I have the following code to return the address of the last cell in VBA
Sub FormulaTest()
Set lRow = Range("I1").SpecialCells(xlCellTypeLastCell).Address
End Sub
I am trying to figure out how to implement this "lRow" into the VBA code for the formula. Can anyone steer me in the right direction?
**EDIT 1
Please see Fernando's comment below. He has the right idea however the solution is still off a bit. Ill try to explain it better in a few comments: First off, The first row is always a title row, the last row is always a sum row, the current tab is the "Sales" tab, and the amount of rows in any given Sales tab will vary (could be I1:I59, could be I:1:I323).
In this example I1 is a row title and I59 is the sum of I2:I58. Rows I2:I58 are dollar amounts. My macro places this formula in J2:J58. This formula takes each row's dollar amount (I2:I58) as a percentage of the total (I59) and multiplies it by an input amount on the Summary tab (the VLOOKUP). This amount is then subtracted proportionately from the dollar value in column I with the J cell showing the result.
I am looking to eliminate the need for the LOOKUP function (selects last non empty cell) within my formula above: LOOKUP(2,1/(C[-1]<>""""),C[-1]).
**EDIT 2
Fernando's solution worked. Thank you all for your input
This would return the last non-empty row in column I
with Worksheets("Summary")
lRow = .Cells(.Rows.Count, "I").End(xlUp).Row
end with
So your code would be
sub testy
dim lRow as long
with Worksheets("Summary")
lRow = .Cells(.Rows.Count, "I").End(xlUp).Row
end with
"=IF(ISNA(MATCH(RC[-9],Summary!C[-8],0)),""n"",RC[-1]-_
((RC[-1]/R"&lRow&"C[-1])*VLOOKUP(RC[-9],Summary!R10C7:R902C8,2,FALSE)))"
In your solution you're using xlCellTypeLastCell. This is very useful, but it calculates based on UsedRange, which may not be what you want. with this, if you have data up to row n and then you update the data and now you have less records, the last row with xlCellTypeLastCell will still be n, so be careful with that.
Assuming that you are doing all your work on the active sheet, looking up to a "Summary" sheet:
Sub fillCol()
Dim aRow As Long, bRow As Long
aRow = Cells(Rows.Count, "I").End(xlUp).Row
bRow = Sheets("Summary").Cells(Rows.Count, "I").End(xlUp).Row
Range("J2:J" & aRow).FormulaR1C1 = "=IF(ISNA(MATCH(RC[-9],Summary!C[-8],0)),""n"",RC[-1]-" _
& "((RC[-1]/" & aRow & ")*VLOOKUP(RC[-9],Summary!R10C7:R" & bRow & "C8,2,FALSE)))"
End Sub
You made need to change the columns which contain the contiguous range (in order to determine the last row)

copy conditional formatting format but not rules/numbers

need some help thinking through how to do this.
ultimately, what i want to achieve is to sum together cells based on if another corresponding cell is 0 or 1. it's a bit convoluted but i'll try my best to explain.
sheet 1 has data that shows, by month, if actuals have come in for the month. a column will display a 0 for accounts/month that need to be added.
sheet 2 has two tables. table 1 pulls in the 0 & 1 from sheet 1 and uses conditional formatting to highlight cells that need to be added. the only thing in this table is 0 & 1. table 2 is the exact same setup as table 1, just with the actual numbers.
my original thought was to just copy the highlighting format from table 1 onto table 2 then use a macro to sum highlighted cells. obviously, i have found that that is not possible.
i tried looking around and haven't found anything that lets me just copy the highlighting format without overwriting the numbers in table 2.
is this possible?
Try this. I'm not sure how your data is laid out, but if it's in a row, you can run this on a new cell at the end of that row (meaning, the next empty column):
Function sumHighlighted(ByVal myRng As Range)
Dim cel As Range, iRow As Range
Dim fSum As Long, totalRows As Long
fSum = 0
For Each cel In Range(Cells(myRng.Row, 1), Cells(myRng.Row, myRng.Column))
If cel.Interior.ColorIndex <> -4142 Then
fSum = fSum + cel.Value
End If
Next cel
Debug.Print "The total in this row is: " & fSum
sumHighlighted = fSum
End Function
Steps:
1. Copy the Cell with conditional Format.
2. Paste to cell where you want (Hold ALT + press E + S + T).
To generate a code, click "Record Macro" first and do the 2 steps above and stop the recording macro once you're done.

How to autofill formula for known number of columns but variable number of rows in excel macro

I writing a macro within which I need to autofill some rows with formulas, across multiple columns.
The number of columns is fixed, but each time the macro runs, the number of rows is variable. I use the "record macro" function and the current macro only ever fills my rows to row 16. Below is the code:
Range("D3:P3").Select
Selection.AutoFill Destination:=Range("D3:P16")
I obviously need to change the "P16" to something dynamic.
I have tried to use the following:
Dim LR As Long
LR = Range("D3:P3" & Rows.Count).End(xlUp).Row
Range("B3:P3").AutoFill Destination:=Range("B3:P" & LR)
I am unsure whether the "Dim LR as Long" has to be placed at the very beginning of my macro - or can it just be placed anywhere?
I am getting an error anyway with what i attempted above giving me an "autofill selectio error" (sorry i cant remember the exact error message.
Would someone be able to point me in the right direction?
LR can be declared anywhere before where you first use it, but it's best to do it at the beginning. Your range for LR is incorrect.
LR = Range("D3:P3" & Rows.Count).End(xlUp).Row
Should be
LR = Range("D3:P3").End(xlUp).Row
You should use xlDown if you are trying to find the end of a range BELOW D3:P3
LR = Range("D3:P3").End(xlDown).Row
Would give you the last row with data in all columns D:P in it below D3:P3
I think you're looking for this:
LR = Range("D3:P" & Rows.Count).End(xlUp).Row
but note that this finds the last row with any content in Column D - if there are later rows with content in Cols E-P but not in Col D then those rows will be ignored.
So I used the information provided to me and managed to get the following:
Dim LR As Long
LR = Range("C3:P" & Rows.Count).End(xlDown).Row
Range("D3:P3").AutoFill Destination:=Range("D3:P" & LR)
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$D$2:P" & LR), , xlYes).Name = _
"Table10"
This allowed me to count the number of rows that had already been populated in column "C", and then take the formulas that already existed in cells D3:P3 and autofill them down through the range until the last populated row of column C.
I then used that structure to make the whole range a table, in this case named "Table10".
Great stuff guys - your help allowed me to get exactly what I wanted. Thanks

Excel search for empty cells, check conditions, write text

I have been doing some basic VBA programming in Excel 2010 but I have been struggling with this challenge for some time. Basically, I have a sheet that is formatted like this (It actually has 62 columns and rows=# of days in the given month):
Column A will be hidden but is used in a few formulas.
Row 15 shows whether or not the station is open 24/7(all) or only Monday-Friday(M-F).
the values presented are arbitrary counts. However, a blank count represents a problem unless... the station is M-F and
I need to get my code to identify a station that is open M-F and then fill in any particular Sat. or Sun (for that station) with the word "closed." then search for the next station that is M-F and repeat the process.
Initially I was having my code start with an actual value and then use several activecell.offset functions to find empty cells and then check conditions but I couldn't get it to work out. Then I tried to check from the station name or the schedule row but I couldn't get the multiple if/nested offset statements to work either.
I would really appreciate any help or insight you could provide that would show me the best approach. I don't really need the code that does it I just need a pseudo code walk-through unless you are kind enough to write out the code.
Thanks for your help!
I had a similar problem I worked out before. I modified it to your spreadsheet:
Dim d As Long, s As Long
d = 1 'weekdays column
s = 40 'status row
Dim r As Long, c As Long
r = ActiveSheet.Cells(Rows.Count, d).End(xlUp).Row
c = ActiveSheet.Cells(s, Columns.Count).End(xlToLeft).Column
Dim i As Long, cell As Range
i = 0
Dim days() As Long
For Each cell In Range(Cells(1, d), Cells(r, d))
If cell.Value = "Sat" Or cell.Value = "Sun" Then
ReDim Preserve days(i)
days(i) = cell.Row
i = i + 1
End If
Next cell
For Each cell In Range(Cells(s, 1), Cells(s, c))
If cell.Value = "M-F" Then
For i = LBound(days) To UBound(days)
Cells(days(i), cell.Column).Value = "closed"
Next i
End If
Next cell

I need a VBA code to count the number rows, which varies from ss to ss, return that number and copy and paste that row and all other columns

I have vba question I have been trying to find the answer for for a long time. I have numerous spreadsheets from numerous clients that I run macro's on, I'm new to coding and have been able to mostly figure out what I need to do. My clients send us data monthly and every month the number of rows change. The columns don't change but the amount of data does. My previous macro's I have just chosen the entire column to copy and paste onto our companies template. This worked fine for must things but has created some really long code and macros take a long time. I would like to write a code that counts how many rows are in a certain column and then from there copies and pastes that however many rows it counted in each column. Only a few columns contain data in every row, so I need it to count the rows in one specific column and apply to that every column. Any help would be appreciated.
Thanks
Tony
Hi Guys,
Still having issues with this, below I pasted the code I'm using if anyone can see why it won't run please help.
Windows("mmuworking2.xlsx").Activate
Workbooks.Open Filename:= _
"C:\Users\I53014\Desktop\QC DOCS\Sample_Data_Import_Template.xlsx"
Windows("mmuworking2.xlsx").Activate
Dim COL As Integer
COL = Range("A:DB").Columns.Select
**Range(Cells(2, COL), Cells(Range("E" & Rows.Count).End(xlUp).Row, COL)).Copy Destination:=Windows("Sample_Data_Import_Template.xlsx").Range("A2")**
Range("A2").Paste
Range("A5000").Formula = "='C:\Users\I53014\Desktop\[Import_Creator.xlsm]sheet1'!$B$2"
ActiveWorkbook.SaveAs Filename:="Range (A5000)", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
I bolded where it keeps stopping.
This should give you the last row containing data:
ActiveSheet.UsedRange.Rows.Count
This will give you the last row in a specific column:
Range("B" & Rows.Count).End(xlUp).Row
here is an example of how I can copy every row in the first three columns of a worksheet
Sub Example()
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
Range(Cells(1, 1), Cells(LastRow, 3)).Copy Destination:=Sheet2.Range("A1")
End Sub
You have to be careful as there are some caveats to both methods.
ActiveSheet.UsedRange may include cells that do not have any data if the cells were not cleaned up properly.
Range("A" & Rows.Count).End(xlUp).Row will only return the number of rows in the specified column.
Rows(Rows.Count).End(xlUp).Row will only return the number of rows in the first column.
Edit Added an example
Edit2 Changed the example to be a bit more clear
For this example lets say we have this data
You could copy any other column down to the number of rows in column A using this method:
Sub Example()
Dim Col as Integer
Col = Columns("C:C").Column
'This would copy all data from C1 to C5
'Cells(1, Col) = Cell C1, because C1 is row 1 column 3
Range(Cells(1, Col), Cells(Range("A" & Rows.Count).End(xlUp).Row, Col)).Copy Destination:=Sheet2.Range("A1")
End Sub
The end result would be this: