Add moving average value in last row using array in Excel VBA - excel

'The code should add the moving average to last row using array. The Prices to be use to average are in range "E6:E7555". The values will be written in "G7555". There is an existing moving average values in range "G6:G7554". Need help from Excel VBA expert to correct the codes which I think in step 1 and 2 below.
Options Explicit
Sub Add_MovingAverage_to_LastRows()
Dim maArray As Variant
Dim runSum, ma() As Double
Dim i, lRow, iPeriod, iCol As Long
iPeriod = 7
'set last row and reference range to calculate
With Worksheets("Sheet1")
lRow = .Cells(Rows.Count, 1).End(xlUp).Row 'Row "7555"
maArray = .Range(.Cells(lRow - (iPeriod -1), 5), .Cells(lRow, 5)).Value2 'Column "E"
End With
'set the lower and upper bound
ReDim ma1(lRow - (iPeriod - 1) To lRow, 1 To 1)
'step 1 calculate the SUM for last row, sum (row "7549" to row "7555")
runSum = 0
For i = lRow - (iPeriod-1) To lRow
runSum1 = runSum1 + maArray(i, 1)
Next
'step 2 calculate the AVERAGE for last row, average (row "7549" to row "7555")
ma(1, 1) = runSum / iPeriod
'write the values to worksheet
iCol = 7 'Column "G"
With Worksheets("Sheet1")
.Range(.Cells(lRow, iCol), .Cells(lRow, iCol)).Value2 = ma
End With
Erase maArray: Erase ma
End Sub

I think you may want to stick to a Formula on G column instead of VBA. If you add this formula on G6 and drag down: (Test it out on column H next to it)
=AVERAGE(INDIRECT("E"&IF(ROW()-6<6,6,ROW()-6)&":"&"E"&ROW()))
The IF Statement is to not break the formula on the first few rows of the file.
It will always grab the last 6+current row of values in Column E to calculate the Average.
Edit: Summary
="E"&IF(ROW()-6<6,6,ROW()-6)&":"&"E"&ROW() if you paste this into I6 and drag down you can see how it is just graving the 7 Cell Range you are looking for. When you enclose this into INDIRECT then you can use this inside other formulas as a "literal range" as in my answer above with AVERAGE.
Edit 2: VBA Code to automatically drag/fill down formula.
Sub UpdateFill()
Dim lRow As Long, lFormulaRow
With ThisWorkbook.Sheets("Sheet1")
lDateRow = .Cells(Rows.Count, 1).End(xlUp).Row
lFormulaRow = .Cells(Rows.Count, 7).End(xlUp).Row
If lDateRow > lFormulaRow Then
.Range("G" & lFormulaRow & ":G" & lDateRow).FillDown
End If
End With
End Sub

Related

I am looking to find the average of the last 6 corresponding weekdays in a dataset

I am looking to create a cash forecast using the average of the last 6 days that correspond to a particular weekday.
My dataset is formatted as such:
Row 1: Headers
Column A: Date
Column F: Cash position
Column G: Day of week
After column G is filtered to a specific day (i.e. Monday), I'd like to extract the last 6 visible values in columns A & F. Using column A as an example, here is my current failed code:
Range("A1").Select
Selection.End(xlDown).Select
Range("A460:A485").Select
Range("A485").Activate
The range on line 3 was coded from shift-clicking upwards 5x from the bottom of the data set. I'm looking to copy the data within this range, while not defining what the range is.
Thanks for any help provided.
Scan up the sheet for 6 dates that are mondays and fill an array. Then dump the array to the other sheet.
Option Explicit
Sub Last6Mon()
Dim ar(1 To 6, 1 To 2) As Variant
Dim lastrow As Long, i As Long, r As Long
i = 6
With Sheets("Sheet1")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For r = lastrow To 2 Step -1
If WorksheetFunction.Weekday(.Cells(r, "A")) = vbMonday Then
ar(i, 1) = .Cells(r, "A") ' date
ar(i, 2) = .Cells(r, "F") ' cash posn
i = i - 1
If i = 0 Then Exit For
End If
Next
'another worksheet
Sheets("Sheet2").Range("A2:B7") = ar
End With
End Sub

How to have conditional sumif formula throughout a range?

i'm trying to do a sumif of cells in column K to the right whenever there's a cell value in column J = "subtotal". Right now my code isn't working and i'm not sure if it's because i wrote my sumif statement wrong. My range starts at row 13 and the last row varies. My condition to sum is to sum the cells in column K as long as the cells in column B are the same.
Please see below for my code! Would appreciate any help for this...I'm getting an optional error but i'm not 100% sure why.
enter code here
dim startrow as long
dim groupstartrow as long
groupstartrow = 13
with ws.name("sheet 1")
mergelastrow = .Cells(.rows.Count, 2).End(xlUp).Row
'every time a cell in column J says GL total,
'add a formula next to it in column K that sums cells from i from beginning of the range
'as long as i in column b is equal to the b on the same row
'as the cells being summed is my goal
For i = startrow + 1 To mergelastrow + 1
If Cells(i, 10) = "subtotal" Then
Range.Cells(i, 11) = "=SUM(" & Cells(groupstartrow, 11).Address & ":" & Cells(i - 1, 11).Address & ")"
groupstartrow = i + 1
End If
end with
end sub

if column A has text and column G is blank then copy row to new spreadsheet

I am trying to create a summary list for people in a downstream application to feed several of my production machines. Each machine is going to have their own tab to request material, and I want all of their requests to be summarized on one tab (called "Core_Cutter_List").
So basically I am trying to create a VBA that will copy over a row from spreadsheet "2" into the next blank line on spreadsheet "Core_Cutter_List". I want it to copy if there is text in column A and column G is blank. I have limited knowledge of VBA. The code that I found was able to only test for one of my criteria which was that column G is blank, but basically it runs through every single cell on my file. Do you know how I can add the other criteria of column A having text in it so that it doesn't look through every cell on my sheet? Thanks for any help!
Sub Test()
'
' Test Macro
'
Sheets("2").Select
For Each Cell In Sheets(1).Range("G:G")
If Cell.Value = "" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("Core_Cutting_List").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("2").Select
End If
Next
End Sub
If you need two conditions, then you should write them carefully in the IF statement with And:
Something like If cell.Value = "" And Len(cell.Offset(0,-6)) Then should be workable.
Using Select is a bit not advisable, but it works at the beginning - How to avoid using Select in Excel VBA
The Sub bellow does the following
Determine the last used row in Worksheets("2") based on values in column A
Determine the last used col in Worksheets("2") based on values in row 1
Determine the last used row in Worksheets("Core_Cutter_List") based on values in column A
Loop through all used rows in Worksheets("2")
If the cell in col A is not empty And cell in col G is empty
Copy entire row to next empty row in Worksheets("Core_Cutter_List")
Increment next empty row for Worksheets("Core_Cutter_List")
Loop to the next used row in Worksheets("2")
Option Explicit
Public Sub CopyRows()
Dim ws1 As Worksheet, ws2 As Worksheet, ws1r As Range, ws2r As Range
Dim ws1lr As Long, ws1lc As Long, ws2lr As Long, i As Long
Set ws1 = ThisWorkbook.Worksheets("2")
Set ws2 = ThisWorkbook.Worksheets("Core_Cutter_List")
ws1lr = ws1.Range("A" & Rows.Count).End(xlUp).Row 'last row in "2"
ws1lc = ws1.Cells(1, Columns.Count).End(xlToLeft).Column 'last col in "2"
ws2lr = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1 'last row in "Core_Cutter"
For i = 1 To ws1lr
If Len(ws1.Cells(i, "A")) > 0 And Len(ws1.Cells(i, "G")) = 0 Then
Set ws1r = ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, ws1lc))
Set ws2r = ws2.Range(ws2.Cells(ws2lr, 1), ws2.Cells(ws2lr, ws1lc))
ws2r.Value2 = ws1r.Value2
ws2lr = ws2lr + 1
End If
Next i
End Sub
My test file
Worksheets("2")
Worksheets("Core_Cutter_List")

Find last row in range

I'm having a little trouble with finding the last row.
What I am trying to do is find the last row in column "A", then use that to find the last row within a range.
Example of Data:
1) LR_wbSelect = wbshtSelect.cells(Rows.count, "A").End(xlUp).Row - 22
2) LR_wbSelectNew = wbshtSelect.cells(LR_wbSelect, "A").End(xlUp).Row
I am using the last row in column "A" as the data from row 29 down will always be the same length, the rows used in column "B" from row 29 can be a varying number of rows.
So I am trying to use LR_wbSelect in column "A" to get my starting last Row, then within LR_wbSelectNew using it as the starting point to look up from.
This works when the column I set to "A", LR_wbSelectNew gives me the row of "17", but when I change the column in LR_wbSelectNew to "B" it doesn't give the correct last row of "18".
I can change the column to "C, D, E, F" and the code works fine, but the only column that I can use is "B" because it will always have data in it, where the rest of that row could have a blank cell.
After doing some testing on the sheet, by pressing CRTL & Up from the lastring point of LR_wbSelect column "B" ignores the data in the rows and go to the row where it find data. I can't see a reason why Excel doesn't think there is data in these cells?
There are mulitple results and methods when searching for the LastRow (in Column B).
When using Cells(.Rows.Count, "B").End(xlUp).Row you will get the last row with data in Column B (it ignores rows with spaces, and goes all the way down).
When using:
With wbshtSelect.Range("B10").CurrentRegion
LR_wbSelectNew = .Rows(.Rows.Count).Row
End With
You are searching for the last row with data in Column B of the CurrentRegion, that starts from cell B10, untill the first line without data (it stops on the first row with empty row).
Full Code:
Sub GetLastRow()
Dim wbshtSelect As Worksheet
Dim LR_wbSelectNew As Long
' modify "Sheet2" to your sheet's name
Set wbshtSelect = Sheets("Sheet2")
' find last row with data in Column B
With wbshtSelect
LR_wbSelectNew = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
' for debug only
Debug.Print LR_wbSelectNew ' >>result 31
' find last row with data in Column B at current regioun starting at cell B10
With wbshtSelect.Range("B10").CurrentRegion
LR_wbSelectNew = .Rows(.Rows.Count).Row
End With
' for debug only
Debug.Print LR_wbSelectNew ' >> result 18
End Sub
Edit1: code searches for last row for cells with values (it ignores blank cells with formulas inside).
Sub GetLastRow()
Dim wbshtSelect As Worksheet
Dim LR_wbSelectNew As Long
' modify "Sheet2" to your sheet's name
Set wbshtSelect = Sheets("Sheet2")
' find last row with data in Column B at current regioun starting at cell B10
With wbshtSelect.Range("B10").CurrentRegion
LR_wbSelectNew = .Rows(.Rows.Count).Row
End With
Dim Rng As Range
Set Rng = wbshtSelect.Range("B10:B" & LR_wbSelectNew)
' find last row inside the range, ignore values inside formulas
LR_wbSelectNew = Rng.Find(What:="*", _
After:=Range("B10"), _
LookAt:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
' for debug
Debug.Print LR_wbSelectNew ' << result 18 (with formulas in the range)
End Sub
Hope this piece of code helps !
Sub LastRowInOneColumn()
'Find the last used row in a Column: column A in this example
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
MsgBox LastRow
End Sub
I came here looking for a way to find the last row in a non-contiguous range. Most responses here only check one column at a time so I created a few different functions to solve this problem. I will admit, though, that my .Find() implementation is essentially the same as Shai Rado's answer.
Implementation 1 - Uses Range().Find() in reverse order
Function LastRowInRange_Find(ByVal rng As Range) As Long
'searches range from bottom up stopping when it finds anything (*)
Dim rngFind As Range
Set rngFind = rng.Find( What:="*", _
After:=rng.Parent.Cells(rng.row, rng.Column), _
LookAt:=xlWhole, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If Not rngFind Is Nothing Then
LastRowInRange_Find = rngFind.row
Else
LastRowInRange_Find = rng.row
End If
End Function
Implementation 2 - Uses Range().End(xlUp) on each column
Function LastRowInRange_xlUp(ByVal rng As Range) As Long
Dim lastRowCurrent As Long
Dim lastRowBest As Long
'loop through columns in range
Dim i As Long
For i = rng.Column To rng.Column + rng.Columns.count - 1
If rng.Rows.count < Rows.count Then
lastRowCurrent = Cells(rng.row + rng.Rows.count, i).End(xlUp).row
Else
lastRowCurrent = Cells(rng.Rows.count, i).End(xlUp).row
End If
If lastRowCurrent > lastRowBest Then
lastRowBest = lastRowCurrent
End If
Next i
If lastRowBest < rng.row Then
LastRowInRange_xlUp = rng.row
Else
LastRowInRange_xlUp = lastRowBest
End If
End Function
Implementation 3 - Loops through an Array in reverse order
Function LastRowInRange_Array(ByVal rng As Range) As Long
'store range's data as an array
Dim rngValues As Variant
rngValues = rng.Value2
Dim lastRow As Long
Dim i As Long
Dim j As Long
'loop through range from left to right and from bottom upwards
For i = LBound(rngValues, 2) To UBound(rngValues, 2) 'columns
For j = UBound(rngValues, 1) To LBound(rngValues, 1) Step -1 'rows
'if cell is not empty
If Len(Trim(rngValues(j, i))) > 0 Then
If j > lastRow Then lastRow = j
Exit For
End If
Next j
Next i
If lastRow = 0 Then
LastRowInRange_Array = rng.row
Else
LastRowInRange_Array = lastRow + rng.row - 1
End If
End Function
I have not tested which of these implementations works fastest on large sets of data, but I would imagine that the winner would be _Array since it is not looping through each cell on the sheet individually but instead loops through the data stored in memory. However, I have included all 3 for variety :)
How to use
To use these functions, you drop them into your code sheet/module, specify a range as their parameter, and then they will return the "lowest" filled row within that range.
Here's how you can use any of them to solve the initial problem that was asked:
Sub answer()
Dim testRange As Range
Set testRange = Range("A1:F28")
MsgBox LastRowInRange_Find(testRange)
MsgBox LastRowInRange_xlUp(testRange)
MsgBox LastRowInRange_Array(testRange)
End Sub
Each of these will return 18.
If your wbshtSelect is defined as worksheet and you have used set to define the specific worksheet, you can use this.
Dim LastRow As Long
wbshtSelect.UsedRange ' Refresh UsedRange
LastRow = wbshtSelect.UsedRange.Rows(wbshtSelect.UsedRange.Rows.Count).Row
Otherwise take a look here http://www.ozgrid.com/VBA/ExcelRanges.htm
LR_wbSelectNew = wbshtSelect.cells(LR_wbSelect, "B").End(xlUp).Row
Why are you using "LR_wbSelect" as the row counter? If you want to know the last row of column 'B', you should use Rows.count
Rows.count --> Returns maximum number of rows (which is 1048576 for Excel 2007 and up)
End(xlUp) --> Moves the pointer upward to the last used row
So,
cells(Rows.count, "A").End(xlUp).Row --> This moves the pointer to the last row if the column 'A' (as if you are pressing Crtl+Up keys when A1048576 cell is selected)
So, use Rows.count to select the last row for column 'B' as well. If you have some specific requirement related to LR_wbSelect, please mention it.
Alternatively, if you want to know the last row used in a sheet, you may use the below:
mySheet.Cells.SpecialCells(xlCellTypeLastCell).Row
LR_wbSelect = ThisWorkbook.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Simple function that return last row no. in specific sheet.
It takes the last address in UsedRange and retrieve last row number.
Feel to free change the code and use standard range insead of UsedRange.
Function FindLastRow(wsToCheck As Worksheet) As Long
Dim str As String
str = wsToCheck.UsedRange.AddressLocal()
FindLastRow = Right(str, InStr(1, StrReverse(str), "$") - 1)
End Function
Range().End will bring you to the end of a code block. If the starting cell is empty, it brings you the the first used cell or the last cell. It the cells is not empty it brings you to the last used cell. For this reason, you need to test whether or not the cell in column B is to determine whether to use LR_wbSelectNew as the last row.
With wbshtSelect
LR_wbSelect = .Cells(Rows.Count, "A").End(xlUp).Row - 22
If .Cells(LR_wbSelect, "B") <> "" Then
LR_wbSelectNew = LR_wbSelect
Else
LR_wbSelectNew = .Cells(LR_wbSelect, "B").End(xlUp).Row
End If
End With
This code defines a Target range that extends from A1 to the last row in column a - 22 and extends 10 columns.
Dim Target As Range
With wbshtSelect
Set Target = .Range("A1", .Cells(Rows.Count, "A").End(xlUp).Offset(-22)).Resize(, 10)
End With
'This is sure method to find or catch last row in any column even 'if some cell are blank in-between. (Excel-2007)`
'This works even if sheet is not active
'mycol is the column you want to get last row number
for n=1048575 to 1 step -1
myval=cells(n,mycol)
if myval<>"" then
mylastrow=n 'this is last row in the column
exit for
end if
next
ret=msgbox("Last row in column-" & mycol & "is=" & mylastrow)
Dim rng As Range
Dim FirstRow, LastRow As long
Set rng = Selection
With rng
FirstRow = ActiveCell.Row
LastRow = .Rows(.Rows.Count).Row
End With
Shai Rado's first solution is a great one, but for some it might need a bit more elaboration:
Dim rngCurr, lastRow
rngCurr = wbshtSelect.Range("B10").CurrentRegion
lastRow = rngCurr.Rows(rngCurr.Rows.Count).Row
If you want to know the last used row in the entire worksheet:
Dim rngCurr, lastRow
rngCurr = Range("A1").CurrentRegion
lastRow = rngCurr.Rows(rngCurr.Rows.Count).Row
Backing off from the range to the worksheet will get you the whole sheet extents of the range used on the sheet (which may be smaller than you expect if the sheet doesn't have data in the top rows; but it does include internal blanks)
TheRange.Worksheet.UsedRange.Rows.Count
If there is no data in the top rows, the following will get you the first row which you need to add to the above to get the highest row number
TheRange.End(xlDown).Row
So
Dim TheRange as Range
Dim MaxRow as Long
MaxRow = TheRange.Worksheet.UsedRange.Rows.Count + TheRange.End(xlDown).Row
Will get the highest row number with data (but not the whole sheet)
Before getting into complex coding why not build something on the below principle:
MaxRow = Application.Evaluate("MIN(ROW(A10:C29)) + ROWS(A10:C29) - 1")

SUM Function in VBA - not hard coding rows and columns

How do I use the lastRow variable in the sum function in vba? After I count the number of words in each row until the last row, I would like to add up the individual totals from each row into an overall total column but I do not want to hard code the range into the sum function in vba? Is there another way?
Example:
Column: A B C D E F
NRow 1: 2 3 4 5 6 7
NRow 2: 3 4 5 6 7 8
Total 3: 5 7 9 11 13 15
Want to avoid SUM(R[-2]C:R[-1]C)? I would like SUM(R[lastRow]C:R[-1]C) or something that would function in the same way.
Thank you!
Something like this which
Sets the usedrange on the active sheet from A1 to the last used cell in column F
Goes to the first cell below this range Cells(rng1.Cells(1).Row + rng1.Rows.Count, 1), resizes to the amount of columns in the range of interest (6 in this case)
Enters the forumula "=SUM(R[-" & rng1.Rows.Count & "]C:R[-1]C)" where rng1.Rows.Count gives the first row dynamically
code
Sub GetRange()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "F").End(xlUp))
Cells(rng1.Cells(1).Row + rng1.Rows.Count, 1).Resize(1, rng1.Columns.Count).Value = "=SUM(R[-" & rng1.Rows.Count & "]C:R[-1]C)"
End Sub
If you can guarantee that there is always data in column A then to find the last row you could do the following:
Option Explicit
Sub addSums()
Dim lstRow As Integer
With Excel.ThisWorkbook.Sheets("Sheet1")
lstRow = .Cells(.Rows.Count, 1).End(Excel.xlUp).Row
Dim j As Integer
For j = 1 To .Cells(1, .Columns.Count).End(Excel.xlToLeft).Column
.Cells(lstRow + 1, j) = "=SUM(R[-" & lstRow - 1 & "]C:R[-1]C)"
.Cells(lstRow + 1, j).Font.Bold = True
Next j
End With
End Sub
Seems to work ok on the following:
If your source data is coming frm an external source, the appropriate mechanism is:
Create a Named Data Range around the input table;
Set the inut table to automatically resize on refresh; and
Then use the Named Data Range in your functions.

Resources