How can I iterate through a row, while using the sum formula for the column above in a for-loop? - excel

I would like to iterate through a row, while summarizing the value of the columns above in a formula. At this point I have data from column 'A' to column 'AV'
The code below does what I want it do, but I'd like to get it into a for-loop that runs preferably to the last column with data. So that I don't have to write 40+ lines of repetitive code.
Dim LastRow As Long
LastRow = ThisWorkbook.Worksheets("Planteleveranse trær 2019").Range("F3").End(xlDown).Row
ThisWorkbook.Worksheets("Planteleveranse trær 2019").Cells(LastRow + 1, "F").Formula = "=SUM(F3:F" & LastRow & ")"
ThisWorkbook.Worksheets("Planteleveranse trær 2019").Cells(LastRow + 1, "L").Formula = "=SUM(L3:L" & LastRow & ")"
ThisWorkbook.Worksheets("Planteleveranse trær 2019").Cells(LastRow + 1, "M").Formula = "=SUM(M3:M" & LastRow & ")"

I think my questions was poorly asked, thanks for pointing that out. The code does what I want it do to, but I wish to extend it. I need to summarize the entire row from 'F' as I have done in my third line of code all the way column 'AV', and I expect more columns of data to be added in the future. I would like this done in a for loop like For char c = 'F' to c = 'AV' ThisWorkbook.Worksheets("Planteleveranse trær 2019").Cells(LastRow + 1, "c").Formula = "=SUM(c3:L" & LastRow & ")" But I do not know the syntax for that in vba. – Glenn Bergstrøm 11 mins ago
In that case I would recommend to find the last row and the last column. Identify your range and enter the formula in that range in one go as shown below. I have commented the code but if you still have a problem understanding it, feel free to ask :)
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long, LastCol As Long
Dim myFormula As String
'~~> Set this to the relevant worksheet
Set ws = Sheet1
With ws
'~~> Find last row
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Find last column in row 1
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
'~~> Construct your formula
myFormula = "=Sum(A2:A" & LastRow & ")"
'~~> Enter formula in the entire range in 1 go
.Range(.Cells(LastRow + 1, 1), _
.Cells(LastRow + 1, LastCol)).Formula = myFormula
End With
End Sub
Screenshot:

Related

VBA Looping cells and Copy based on criteria

[Copy A2 to E2 till the end of row of the table and check if the cell is within the same month](https://i.stack.imgur.com/Q7YAx.png)
Hi,
I would like to loop through rows from a sheet table from column A2 to E2 to A3 to E3... till the end of the table Ai to Ei by defining a variable and counting the last row of the table.
As the second step, I would like to copy the cells into another sheet and fill it the corresponding months.
[Desired Output--> it will copy the data and return to another sheet in the corresponding month] (https://i.stack.imgur.com/zhgYh.png)
Instead, I've changed the data type into a number format and have set up two condition to loop through.
eg. 1/1/2017 change to 42736
28/2/2017 change to 42794
Sub Mike_Copy_cell()
Dim i As Long 'for looping inside each cell
Dim myvalue As Variant
Dim Lastrow As Long
Const StartRow As Byte = 2
Dim LastMonth As Long
("Mike Filter").Select
Lastrow = Range("A" & StartRow).End(xlDown).Row
For i = StartRow To Lastrow
myvalue = Range("H" & i).Value
If myvalue \< Sheets("Automate Report").Range("A" & i).Value \_
'First data Feb Data 42794 \< Jan Category 42736
Then Sheets("Automate Report").Range("B" & i).Value = ""
'leave the cells in blanks and loop through next cell
If myvalue > Sheets("Automate Report").Range("A" & i).Value _
'First data Feb Data 42794 > Jan Category 42736
Then Range("A" & i, "E" & i).Copy Sheets("Automate Report").Range("B" & i, "F" & i)
'Copy the cells into corresponding category
Next i
End sub()
In my output, it is able to loop through and copy all the cells. However, I am wondering the reason why VBA output is not able leave any blank cells when the first condition is met ?
**I am expecting some blanks in the table if it is not data is not within the same month or in my case is less than criteria I have set. **
The output of my code
If myvalue < Sheets("Automate Report").Range("A" & i).Value _
Then Sheets("Automate Report").Range("B" & i).Value = ""
Greatly appreciate if you can advise the flaws in my code. Massive Thanks.
Best regards,
Kenneth
I'll try to help. But before, may I give you two suggestions that might help you?
First, for me the best way to find the last row is, instead of using xldown from the first row, using xlup from the very last row of excel. This way, if there is a blank in any middle row, the code still gives you the last row with value.
Second, I found that referring to any cells with the "range" method may limit you sometimes when using variables in this reference. I think using the "cells(row, column)" method is more useful.
Why not trying this?
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Sorry for the suggestions, It's just that I wish someone had taught them to me sooner.
Back to the topic, I think the problem is how you structure the "if" statement. Allow me to change it a bit:
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = StartRow To Lastrow
myvalue = cells(i, 8).Value
'if myvalue date is equal or previous to the one found in Ai...
If myvalue <= Sheets("Automate Report").cells(i, 1).Value then
Sheets("Automate Report").cells(i, 2).Value = ""
'but if myvalue is later than Ai...
else
sheets("Automate Report").select
range(cells(i, 1), cells(i, 5).select
selection.copy
cells(i, 2).select
activesheet.paste
end if
Next i
Hope this helps. Best regards,
Mike
I'm not sure what your code is doing but consider using an array(12) of row numbers, one for each month. Copy lines into corresponding month and increment the row number for that month. For example ;
Option Explicit
Sub Mike_Copy_cell()
Const LINES_MTH = 5 ' lines per month
Dim wb As Workbook
Dim wsIn As Worksheet, wsOut As Worksheet
Dim lastrow As Long, rIn As Long, rOut(12) As Long
Dim uid As String, prevuid As String
Dim dAVD As Date, m As Long, n As Long
Set wb = ThisWorkbook
Set wsIn = wb.Sheets("Mike Filter")
Set wsOut = wb.Sheets("Automate Report")
' space out months
For n = 0 To 11
rOut(n + 1) = 2 + n * LINES_MTH
wsOut.Cells(rOut(n + 1), "A").Value2 = MonthName(n + 1)
Next
n = 0
With wsIn
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For rIn = 2 To lastrow
dAVD = .Cells(rIn, "D")
' create a unique ID to skip duplicates
uid = .Cells(rIn, "A") & Format(.Cells(rIn, "D"), "YYYY-MM-DD")
If uid <> prevuid Then
m = Month(dAVD)
.Cells(rIn, "A").Resize(, 5).Copy wsOut.Cells(rOut(m), "B")
rOut(m) = rOut(m) + 1
n = n + 1
End If
prevuid = uid
Next
End With
MsgBox n & " lines copied to " & wsOut.Name, vbInformation
End Sub

Formula in first blank and filled down to end of data

I have the below code where in all other columns there is many populated rows, what I need this formula to do in column F is to find the first blank, then place the formula in it and fill it down to the last row.
What is currently happening is I have the range as F26 as this is usually first blank but this could change and I want the code to identify this and also have the formula dynamically know what row it is on, so for example if one month the first blank was in cell F30 the range would find it and the formula would start as E30*G30.
Any help would be greatly appreciated.
Private Sub calc()
Dim lastrow As Long
Dim rng As Range
lastrow = ThisWorkbook.Worksheets("Indiv").Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("F26:F" & lastrow)
rng.Formula = "=Round((E26*G26),2)"
End Sub
You need to find the first free row in column F and then bulid your formula with this row:
Option Explicit
Private Sub calc()
Dim ws As Worksheet ' define worksheet
Set ws = ThisWorkbook.Worksheets("Indiv")
Dim LastRowA As Long ' find last used row in column A
LastRowA = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim FirstFreeRowF As Long ' find first free row in column F (if first 2 rows have data)
FirstFreeRowF = ws.Cells(1, "F").End(xlDown).Row + 1
' fix issue if first or second row is empty
If FirstFreeRowF = ws.Rows.Count + 1 Then
If ws.Cells(1, "F").Value = vbNullString Then
FirstFreeRowF = 1
ElseIf ws.Cells(2, "F").Value = vbNullString Then
FirstFreeRowF = 2
End If
End If
' define range to add formula
Dim Rng As Range
Set Rng = ws.Range("F" & FirstFreeRowF, "F" & LastRowA)
' add formula
Rng.Formula = "=Round((E" & FirstFreeRowF & "*G" & FirstFreeRowF & "),2)"
End Sub
So this will consider F5 the first free row and fill in the formula in the selected range as seen below:
I think you should find the last used row in column F, so that you could know the next row is blank
lastrowF=sheets(sheetname).range("F" & rows.count).end(xlup).row
So the next row would be like
range("F" & lastrowF+1).formula="Round((E" & lastrowF+1 & "*G" & lastrowF+1 & ",2)"

How to fill in from dynamic last row in one column to the last row in adjacent column?

I have been trying some time now with the following problem: First code (not listed here) drops data in sheet EDD in column B (B45 to be precise), then each cell in col A is populated with number 1 (from A45 to the bottom of column B) - as the code below shows.
Now the problem is that I will be adding another set of data in column B (to the bottom of what has already been added) but this time this new data will have number 2 in each cell of the column A (ps. I cannot overwrite number 1's that I have already entered) - the issue is that the data is dynamic. I do not know how to identify the last row in column A (populated it with value = 2 and autofill it to the bottom of this new data in column B).
Dim EDDx As Worksheet
Dim lastrow As Long
Set EDDx = Sheets("EDD")
lastrow = EDDx.Cells(Rows.Count, "C").End(xlUp).Row
With EDDx
.Range("B45:B" & lastrow).Value = 1
End With
End Sub
Thanks
Try,
with workSheets("EDD")
.range(.cells(.rows.count, "B").end(xlup), _
.cells(.rows.count, "C").end(xlup).offset(0, -1)).filldown
end with
Try:
Option Explicit
Sub Test()
Dim LastrowC As Long
Dim LastrowB As Long
With wsTest
LastrowB = .Range("B" & Rows.Count).End(xlUp).Row
LastrowC = .Range("C" & Rows.Count).End(xlUp).Row
.Range("B" & Lastrow + 1 & ":C" & LastrowC).Value = "2"
End With
End Sub

Excel VBA offset function

I have an Excel file with information in column A and column B. Since these columns could vary in the number of rows I would like to use the function offset so that I could print the formula in one time as an array rather than looping over the formula per cell (the dataset contains almost 1 million datapoints).
My code is actually working the way I want it to be I only can't figure out how to print the code in Range(D1:D5). The outcome is now printed in Range(D1:H1). Anybody familiar how to use this offset within a for statement?
Sub checkOffset()
Dim example As Range
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Set example = Range("A1:A1")
For i = 1 To LastRow
example.Offset(0, i + 2).Formula = "=SUM(A" & i & ":B" & i & ")"
Next i
End Sub
Using the Offset(Row, Column), you want to offset with the increment of row (i -1), and 3 columns to the right (from column "A" to column "D")
Try the modified code below:
Set example = Range("A1")
For i = 1 To LastRow
example.Offset(i - 1, 3).Formula = "=SUM(A" & i & ":B" & i & ")"
Next i
One way of outputting the formula in one step, without looping, to the entire range, is to use the R1C1 notation:
Edit: Code modified to properly qualify worksheet references
Option Explicit
Sub checkOffset()
Dim example As Range
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
With sht
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set example = .Range(.Cells(1, 1), .Cells(LastRow, 1))
End With
example.Offset(columnoffset:=3).FormulaR1C1 = "=sum(rc[-3],rc[-2])"
End Sub
You don't need to use VBA for this. Simply type =sum(A1:B1) in cell D1 and then fill it down.
If you're going to use VBA anyway, use this:
Sub checkOffset()
Dim example As Range
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Set example = Range("A1:A1")
For i = 1 To LastRow
example.Offset(i - 1, 3).Formula = "=SUM(A" & i & ":B" & i & ")"
Next i
End Sub
The way offset works is with row offset, column offset. You want the column to always be fixed at 3 to the right.

IF statement including VLOOKUP

Looking for a way to do an IF cell says (this) then VLOOKUP here, IF cell says (thiselse) then VLOOKUP different area.
Might be a super obvious way to do this, so far have this:
Pretty simple but not working
Sub categoryVLOOKUP()
'IF col D says STAR then enter VLOOKUP formula into column K
'IF col D says SUN then enter other VLOOKUP formula into column K
Dim lRow As Long, lCol As Long
Dim lRow2 As Long
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("STARSUN")
For lRow = 2 To LastRow
If sht.Cells(lRow, 4) = "SUN" Then
sht.Cells(lRow, 10).Formula = _
"=VLOOKUP(A3&G3,OF_MOON!A:D, 4,0)"
Else
End If
If sht.Cells(lRow, 4) = "STAR" Then
sht.Cells(lRow, 10).Formula = _
"=VLOOKUP(A3&G3,OFWORLD!A:D, 4,0)"
Else
End If
Next lRow
End Sub
If it is getting the formula for multiple cells that is the struggle, I would recommend R1C1 formatting:
Sub categoryVLOOKUP()
'IF col D says STAR then enter VLOOKUP formula into column K
'IF col D says SUN then enter other VLOOKUP formula into column K
Dim lRow As Long, lCol As Long
Dim lRow2 As Long
Dim sht As Worksheet
Dim LastRow as long
LastRow = Cells(Rows.Count, "D").End(xlUp).Row
Set sht = ThisWorkbook.Worksheets("STARSUN")
For lRow = 2 To LastRow
If sht.Cells(lRow, 4) = "SUN" Then
sht.Cells(lRow, 10).FormulaR1C1 = _
"=VLOOKUP(R[1]C[-8]&R[1]C[-1],OF_MOON!RC:RC[3], 4,0)"
ElseIf
If sht.Cells(lRow, 4) = "STAR" Then
sht.Cells(lRow, 10).FormulaR1C1 = _
"=VLOOKUP(R[1]C[-8]&R[1]C[-1],OFWORLD!RC:RC[3], 4,0)"
End If
Next lRow
End Sub
I think this train of thought should get you started. Remember that R1C1 has to be done in reference to the active cell that the formula will go in. I may need to check the rules for referring to new sheets but again, this should get you on the right line :) hope it helps
EDIT : Also, I believe you do need to set LastRow
I have added to the code
Dim LastRow as long
and
LastRow = Cells(Rows.Count, "D").End(xlUp).Row
Looks like you are missing definition and value of LastRow.
Use option explicit at the beginning of your modules to enforce variable declaration. Or simply Tools -> Options -> check Require Variable Declaration. It will be done automatically.
Also I do not understand why you would even use VBA for this. Can't you just use formula
=IF(cell="SUN",1st vlookup, if(cell="STAR", 2nd vlookup,NA())
Also I suggest using INDEX + MATCH instead of VLOOKUP.
And 3rd "also": you are hardcoding the key you will be looking up for: A3&G3. Thus You will get max of 3 values from your actions: Whatever is associated with A3&G3 in OF_MOON sheet or in OFWORLD sheet or #N/A.
Another way to get the result as below
Sub categoryVLOOKUP()
Dim lRow As Long, lCol As Long
Dim lRow2 As Long
Dim sht As Worksheet
LastRow = Range("D" & Rows.Count).End(xlUp).Row
Set sht = ThisWorkbook.Worksheets("STARSUN")
For lRow = 2 To LastRow
If sht.Cells(lRow, 4) = "SUN" Then
Range("K" & lRow).Value = Application.WorksheetFunction.VLookup(Range("A" & lRow) & Range("G" & lRow), Worksheets("OF_MOON").Range("A:D"), 4, 0)
ElseIf sht.Cells(lRow, 4) = "STAR" Then
Range("K" & lRow).Value = Application.WorksheetFunction.VLookup(Range("A" & lRow) & Range("G" & lRow), Worksheets("OF_MOON").Range("A:D"), 4, 0)
End If
Next lRow
End Sub

Resources