Requirement :
Need to auto populate the formula only for the cells which has the data.
Solution :
Created formula via VB script :
Sub Insert_Formula()
Dim Lastrow As Long
Lastrow = Range("DJ" & Rows.Count).End(xlUp).Row
Range("DK2:DK" & Lastrow).Formula = "=TIMEVALUE(DH2)"
End Sub
Issue:
*Now the formula is being applied to first row also. How can I exclude the header row ?
And result of the first row is being populated in remaining rows (though the formula is relevantly populated).
Or is there any other way to auto populate the formulas dynamically based on the data available ?*
As mentioned in the comments by SJR, the value of Lastrow is 1. In order to fix it, simply write:
If Lastrow = 1 Then Lastrow = 2
Range("DK2:DK" & Lastrow).Formula = "=TIMEVALUE(DH2)"
Related
With my VBA Code i add a new line to a table. In the last row of the table i have a =Sum(SumIf(...)) Formula, this row will jump one row down if i add the new line.
So now i want to add the added line to the Formula.
This is my Code so far:
Private Sub CommandButton1_Click()
Dim lastrow As Long
Dim i As Integer
lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
i = 4
Do Until i = lastrow
calc = "SUMIF($K$3:$K$19,N" & i & ",$L$3:$L$19))"
ActiveSheet.Range("N" & lastrow + 1 & ":BI" & lastrow + 1).Formula = "=SUM(SUMIF($K$3:$K$19,N3,$L$3:$L$19)," & calc
i = i + 1
Loop
End Sub
In fact it works fine, but in the End the Formula looks like this:
=Sum(SumIf($K$3:$K$19,N3,$L$3:$L$19),SumIF($K$3:$K$19,N21,$L$3:$L$19))
What do i have to add to the code that every row will be added to the Formula?
Hope someone can help me. I am new to VBA.
EDIT:
The Worksheet shows all assignments and the working progress. With a CommandButton i add a new assignment to the table. So right now my table has 20 rows, in row 21 is the =SUM(SUMIF(..)) - Formula. If i add a new assignment the formula goes to row 22 and in row 21 the new assignment will be shown.
With my Code i want that every row will be added to the formula. Right now the formula goes from N3 to N20. If i add the new line the N21 will not be added to the formula. With my code above it only shows the first and the last row.
In fact i want that the formula will look like this:
=SUM(SUMIF($K$3:$K$19,N3,$L$3:$L$19),SUMIF($K$3:$K$19,N4,$L$3:$L$19) ... SUMIF($K$3:$K$19,N21,$L$3:$L$19))
This is my table hope it will help
This will solve your problem.
You need to assign a value to the variable "calc" before your loop. Then add to its value inside the loop with another statement. Finally, do not put the formula into the cells' values until after you have exited the loop and add a final parentheses to the formula.
Dim lastrow As Long
Dim i As Integer
lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
i = 4
calc = "=SUM(SUMIF($K$3:$K$19,N3,$L$3:$L$19),"
Do Until i = lastrow
calc = calc & "SUMIF($K$3:$K$19,N" & i & ",$L$3:$L$19),"
i = i + 1
Loop
ActiveSheet.Range("N" & lastrow + 1 & ":BI" & lastrow + 1).Value = calc & ")"
This question already has answers here:
How do I put double quotes in a string in vba?
(5 answers)
Closed 1 year ago.
I am attempting to write some VBA which will add header text to 3 cells then fill a formula all the way down to the last row. I have written the below, which writes the headers no problems, but when it get's to my first .Formula it throws a
Application Defined or Object Defined error
What needs to be altered so that this macro will execute successfully? (The formulas were pulled directly from the formula in the cell, so I know they are valid formulas at least on the "front-end")
Function Gre()
Range("E2").Select
ActiveCell.FormulaR1C1 = "Under"
Range("F2").Select
ActiveCell.FormulaR1C1 = "Over"
Range("G2").Select
ActiveCell.FormulaR1C1 = "Result"
With Range("E2:E" & Cells(Rows.Count, "C").End(xlUp).Row)
.Formula = "=IF(C2<B2,B2-C2,"")"
End With
With Range("F2:F" & Cells(Rows.Count, "C").End(xlUp).Row)
.Formula = "=IF(C2>B2,C2-B2,0)"
End With
With Range("G2:G" & Cells(Rows.Count, "C").End(xlUp).Row)
.Formula = "=IF(F2>0,'Issue',"")"
End With
End Function
The problem is likely that you are escaping the quotes with the formula.
What you need is:
.Formula = "=IF(C2>B2,B2-C2,"""")"
for the first one, for example. The other quotes need to be doubled as well.
As a side-note, it would also be best to specify the sheet you are working on with something like:
Dim ws as worksheet
Set ws = Sheets("mySheet")
ws.Range("E2").FormulaR1C1 = "Under"
etc.
If you don't do this, you can sometimes have errors happen while running the code.
As suggested by OpiesDad, to minimize ambiguity, avoid ActiveCell and the like.
Using Select will also slow down performance a lot compared to assigning to cells directly.
I'm pretty sure you need to escape quotes in Excel formulas inside of VBA by doubling the quotes, so a normal empty string becomes """". You also have Issue in single quotes in a formula, which I'm pretty sure will error in Excel; that should be in escaped double quotes as well.
I'm having a hard time figuring out what Range("E2:E" & Cells(Rows.Count, "C").End(xlUp).Row) actually does, but it sounds like you want to select E2 to the last used row of the sheet. Avoid Rows.Count or just generally referring to the rows of a sheet, as that will go to row 10^31. Use Worksheet.UsedRange to get the range from the first row and column with content to the last row and column with content. This also includes empty strings and can be a bit tricky sometimes, but is usually better than dealing with thousands of extra rows.
Also,
You don't need to use With if your only enclosing one statement, although it won't cause any problems.
I would not mix use of Range.Formula and Range.FormulaR1C1 unless you have a reason to.
Function Gre()
Dim ws as Worksheet
Set ws = ActiveSheet
Dim used as Range
Set used = ws.UsedRange
Dim lastRow as Integer
lastRow = used.Row + used.Rows.Count - 1
ws.Range("E2").Formula = "Under"
ws.Range("F2").Formula = "Over"
ws.Range("G2").Formula = "Result"
ws.Range("E2:E" & lastRow).Formula = "IF(C2<B2, C2-B2, """")"
ws.Range("F2:F" & lastRow).Formula = "IF(C2<B2, C2-B2, 0)"
ws.Range("G2:G" & lastRow).Formula = "IF(F2>0, ""Issue"", """")"
End Function
The first issue is the selecting of cells. This requires the macro to select the cell, then determine the cell address. If you need to actually select a cell, use Application.ScreenUpdating = False. Then the macro doesn't have to show the cursor selection of a cell. Dropping the select and incorporating the range into the formula assignment code line like below will gain some speed/efficiency.
Range("E2").FormulaR1C1 = "Under"
Range("E2:E" & Cells(Rows.Count, "C").End(xlUp).Row) is the code version of selecting the last cell in a blank column (row 1048576), then using the keystroke of ctrl and the up key to determine the lowest/last used cell. This gets you a row count of 1 every time since the column is blank. Since you're looking for the last row. It may be faster to count down from the top. My favorite method for this is a loop. Increment a variable within a loop, while looking for the last row. Then, the variable can be used instead of your bottom up strategy.
t = 0
Do Until Range("C2").Offset(t, 0).Value = ""
t = t + 1
Loop
With Range("E2:E" & t)
.Formula = "=IF(C2<B2,B2-C2,"""")"
End With`
Just like TSQL, quote characters need their own quote characters.
.Formula = "=IF(C2<B2,B2-C2,"""")"
The Range Fillup VBA function can be utilized in this case to fill all cells from the bottom with a common formula, accounting for Excel Formula Reference Relativity. The code below starts with the range that we got from the loop counter. Next, we set a variable equal to the total rows in Excel minus the row corresponding to the counter row. Then, we resize the original region by the necessary rows and use the FillDown function to copy the first formula down.
Here's the resulting code. This will fill the range starting from the last row in Excel.
Sub Gre()
Range("E2").FormulaR1C1 = "Under"
Range("F2").FormulaR1C1 = "Over"
Range("G2").FormulaR1C1 = "Result"
Do While Range("e2").Offset(t, 0).Value <> ""
t = t + 1
Loop
Range("E2").Offset(t, 0).Formula = "=IF(C2<B2,B2-C2,"""")"
r1 = Range("e2").EntireColumn.Rows.Count
r2 = Range("E2").Offset(t, 0).Row
Range("E2").Offset(t, 0).Resize(r1 - r2, 1).FillDown
Range("F2").Offset(t, 0).Formula = "=IF(C2>B2,C2-B2,0)"
Range("F2").Offset(t, 0).Resize(r1 - r2, 1).FillDown
Range("G2").Offset(t, 0).Formula = "=IF(F2>0,""Issue"","""")"
Range("G2").Offset(t, 0).Resize(r1 - r2, 1).FillDown
End Sub
As well as using double quotes you may need to use 0 in the first two formula otherwise they may evaluate to empty strings. This may give unexpected results for the last formula i.e. incorrectly return "Issue".
If you do not have blank columns between your data and the 3 new columns you can use CurrentRegion to determine the number of rows:
Range("E2:E" & Cells.CurrentRegion.Rows.Count).Formula = "=if(C2'<'B2,B2-C2,0)"
Range("F2:F" & Cells.CurrentRegion.Rows.Count).Formula = "=if(C2>B2,C2-B2,0)"
Range("G2:G" & Cells.CurrentRegion.Rows.Count).Formula = if(F2>0,""Issue"","""")"
Please try the following sample hope it will help you to wright formula in VBA
Sub NewEntry()
Dim last_row As Integer
Dim sht1 As Worksheet
Dim StockName As String
Set sht1 = Worksheets("FNO MW")
last_row = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'MsgBox last_row
StockName = sht1.Cells(last_row, 1).Value
sht1.Cells(last_row, 1).Formula = "=RTD(""pi.rtdserver"", ,"" " & StockName & " "", ""TradingSymbol"")"
End Sub
I need code, as my title suggests, for the following task. I already tried a lot of different code but it's still not working.
I only need to move 2 columns, "SKU" and "Discount", into sheet2 using command button and delete it right away.
I'm already okay for this coding. However, but the problem is just beginning.
When I succeed to moved the first data, and try to move the 2nd data, the 1st data disappears.
I already tried many ways but still can't figure it out what's wrong with the code.
Please check the following code:
Sub OUTGOING_GOODS()
function1
function2
clear
Range_End_Method
End Sub
Sub function1()
Sheets("Invoice Print").Range("B21:B27").Copy Destination:=Sheets("Outgoing Goods").Range("D4")
End Sub
Sub function2()
Sheets("Invoice Print").Range("D21:D27").Copy Destination:=Sheets("Outgoing Goods").Range("L4")
End Sub
Sub clear()
Range("B21:B27").clear
End Sub
I also need to change the range for input data as well. As you can see the Range is defined only from D21:D27, but I need more than row 27 just in case there is additional data inputted.
Already tried the following code:
With Worksheets("Sheet2")
LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
LastRow = .Cells(.Rows.Count, "L").End(xlUp).Row
For Each cell In Range("D4:D" & LastRow)
DestinationRow = LastRow + 1
Next
For Each cell In Range("L4:L" & LastRow)
DestinationRow = LastRow + 1
Next
End With
And
Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To InputData
Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
For j = 1 To 3
.Cells(lastrow + 1, j).Value = InputData(i, j)
Next j
Next i
End With
This still isn't working.
Based on our discussions thus far I'd suggest the following:
Sub Outgoing_Goods_New()
'
Dim Outgoing As Worksheet 'Generally it's better to use Worksheet variables. Saves the trouble of having to re-type the sheet name each time you reference the sheet
Dim Invoice As Worksheet
Dim LastRow_Invoice As Long
Dim LastRow_Outgoing As Long
Set Outgoing = ActiveWorkbook.Worksheets("Outgoing Goods")
Set Invoice = ActiveWorkbook.Worksheets("Invoice Print")
'Find the last row of Outgoing column D that's used so we know where to paste the new set of outgoing goods
LastRow_Outgoing = Outgoing.Range("D1048576").End(xlUp).Row
'Make sure column L of Outgoing ends at the same point
If Outgoing.Range("L1048576").End(xlUp).Row > LastRow_Outgoing Then
LastRow_Outgoing = Outgoing.Range("L1048576").End(xlUp).Row
End If 'else column L's last used row is farther up the worksheet or the same row. Either way no need to update the value
'Determine how much data to copy
LastRow_Invoice = Invoice.Range("B1048576").End(xlUp).Row 'I'm assuming Column D of Invoice Print has to end at the same row. If not, use the same IF statement as above, but
'checking column D of Invoice
'Copy the data from column B
Invoice.Range("B2:B" & LastRow_Invoice).Copy
'Paste to Outgoing Goods
Outgoing.Range("B" & LastRow_Outgoing).PasteSpecial xlPasteAll
'Copy Column D of Invoice
Invoice.Range("D2:D" & LastRow_Invoice).Copy
Outgoing.Range("L" & LastRow_Outgoing).PasteSpecial xlPasteAll
'Clear the data from Invoice print
Invoice.Range("B2:B" & LastRow_Invoice).ClearContents 'Removes the Value, but leaves formatting, comments, etc. alone
End Sub
This is mostly the logic you already had, but I did some clean-up to remove ambiguities and genericize the logic a little. Also, notice that I didn't keep the separate Subs. With how little you're doing there's just not any benefit to parsing the logic, especially with none of the code being re-used.
Last, I didn't delete column D on Invoice Print assuming that the cells just held formulas that pull in new data based on the values in Column B. If that's not the case, it seems like you should add a second ClearContents to delete Column D as well, but that's not certain given the vagueness of your use case.
I have done a fair bit of searching and can't find an answer for this specific case.
My data set is ~650k lines long so I have been trying to make the code as quick as possible.
What I am trying to do is get VBA to index match an entire column with another sheet.
So far my code is VB:
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("Q2:Q" & LastRow).Value = Evaluate("INDEX(MATCH(C2:C" & LastRow & ",'CC Map'!A:A,0),0)")
This very quickly compares column C to sheet 'CC Map'!A:A; and puts the value in column Q.
However, I want to return the corresponding value from 'CC Map'!B:B
When I use
VB:
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("Q2:Q" & LastRow).Value = Evaluate("INDEX('CC Map'!B:B,MATCH(C2:C" & LastRow & ",'CC Map'!A:A,0))")
It returns every value the same (corresponding to match C2...)
I think the issue is with having an array as the second argument in INDEX, but I am trying to avoid loops.
What I have at the moment runs almost instantly.
If the return values are text, you could use:
Range("Q2:Q" & LastRow).Value = Evaluate("INDEX(IF(1,T(OFFSET('CC Map'!B1,MATCH(C2:C" & LastRow & ",'CC Map'!A:A,0)-1,0))),)")
For numeric values, replace T with N.
I'm trying to do a SUMIFS calculation in VBA. It works fine when I enter it on the spreadsheet, but when I try to convert it to VBA, it doesn't seem to work.
Sheets("Master").Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row).Formula = _
"=SUMIFS(Input!C32,Input!C37,Master!C1,Input!C31,Master!R1C)"
This is the snippet of code (originally in a comment):
Dim LastRow As Long
Dim rw As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For rw = 2 To LastRow
Sheets("Master").Cells(rw, 2).Value = Application.WorksheetFunction.SumIfs(Sheets("Input").Range("AF:AF"), Sheets("Input").Range("AK:AK"), Sheets("Master").Range("A:A"), Sheets("Input").Range("AE:AE").Sheets("Master").Range("B2"))
Next
You aren't specifying the values you want to lookup in your criteria1. You have to specify a value, not a range.
Your sum range is fine.
Sheets("Input").Range("AF:AF")
Your criteria range1 is fine.
Sheets("Input").Range("AK:AK")
Your criteria1 needs to be a value, not a range.
Use this Sheets("Master").Range("A2").value
instead of Sheets("Master").Range("A:A")
Obviously you can replace the 2 in the criteria1 with a variable if you need to to get your loop to work.