I am new to VBA and kindly need your help.
I have code that uses an if statement and would love to be able to autofill. Here is the code below.
Any help will be much appreciated.
Sub PaymentPriority()
If Cells(3, 4) = "FED_ASS_DM" And Cells(3, 5) = "NOCHG" Then
Cells(3, 33) = "999"
Else
Cells(3, 33) = "No Value"
End If
End Sub
The formula that you are looking for in cell AG3 is =IF(AND(D3="FED_ASS_DM",E3="NOCHG"),999,"No Value") which is what your VBA code is doing. Now all you have to do is find the last row and enter the formula in the entire range in 1 go.
Is this what you are trying?
Sub PaymentPriority()
Dim ws As Worksheet
Dim sFormula As String
'~~> Change this to the relevant sheet
Set ws = Sheet1
sFormula = "=IF(AND(D3=""FED_ASS_DM"",E3=""NOCHG""),999,""No Value"")"
With ws
'~~> Find last row
lrow = .Range("D" & .Rows.Count).End(xlUp).Row
'~~> Enter the formula in the entire range in 1 go
.Range("AG3:AG" & lrow).Formula = sFormula
End With
End Sub
Related
I want to paste the formula into a column by searching the column using its name.
My column name is Date1.
I want to find Date1 in my sheet and paste the following formula:
IF(ISBLANK(B5),"""",IF(ISBLANK(O5)=TRUE,""Missing PSD"",TODAY()-O5))
This should be calculated until the last row of Date1 column.
Kindly share any knowledge you have on this, it'd be very helpful.
Sub FillFormula()
Set wb = ActiveWorkbook
Dim sh As Worksheet, lastRow As Long
Set sh = wb.Worksheets("Sheet1")
lastRow = sh.Range("O" & Rows.count).End(xlUp).Row 'chosen O:O column, being involved in the formula...
sh.Range("AC5:AC" & lastRow).Formula = "=IF(ISBLANK(B5),"""",IF(ISBLANK(O5)=TRUE,""Missing PSD"",TODAY()-O5))"
lastRow2 = sh.Range("R" & Rows.count).End(xlUp).Row
sh.Range("AD5:AD" & lastRow).Formula = "=IF(ISBLANK(B5),"""",IF(ISBLANK(R5)=TRUE,""Missing RSD"",TODAY()-R5))"
End Sub
This is the code I am currently using and it works properly but my columns might change so I do not want to use the column character but instead the column name to paste the data into the correct column.
Try the next code, please. It still calculates the last row based on O:O column. If the column "Date1" has already formulas to be overwritten, I can easily adapt the code to use it:
Sub FillFormulaByHeader()
Dim wb As Workbook, sh As Worksheet, lastRow As Long, celD As Range
Set wb = ActiveWorkbook
Set sh = wb.Worksheets("Sheet1")
'Find the header ("Date1"):
Set celD = sh.Range(sh.Range("A1"), sh.cells(, cells(1, Columns.count).End(xlToLeft).Column)).Find("Date1")
If celD Is Nothing Then MsgBox "Nu such header could be found...": Exit Sub
lastRow = sh.Range("O" & rows.count).End(xlUp).row 'it can be easily changed for column with Date1 header
sh.Range(sh.cells(5, celD.Column), sh.cells(lastRow, celD.Column)).Formula = _
"=IF(ISBLANK(B5),"""",IF(ISBLANK(O5)=TRUE,""Missing PSD"",TODAY()-O5))"
End Sub
For simplicity, let's assume you have Headers in Row1. We now need to find out which column our Date1 Value is in. We can do this by simply looping over the Header Range an check if the Value equals "Date1". Now we can use this information to construct the final Range.
Sub FindDate1()
Dim c As Range
Dim date1Column as integer
Dim finalRange As Range
For Each c In Range("A1:Z1")
If c.Value = "Date1" Then
date1Column = c.Column
Exit For
End If
Next c
If date1Column = 0 Then
'in case "Date1" was not found
Exit Sub
Else
Set finalRange = Range(Cells(2, date1Column), Cells(2, date1Column).End(xlDown))
For Each c In finalRange
c.Formula = "=IF(ISBLANK(B" & c.Row & "),"""",IF(ISBLANK(O" & c.Row & ")=TRUE,""Missing PSD"",TODAY()-O" & c.Row & "))"
Next c
End If
End Sub
I'm a beginner. Just learning by Googleing, but cannot find a solution for this. Please help.
I want to run the below macro.
I have multiple cells named "CV_=CVCAL" in the same column.
What I want is for the macro to find the first cell with the value "CV_=CVCAL" and offset to the adjacent cell. If the adjacent cell has a particular value, if the value is below lets say "1.5" i want to fill it will a cell style 'bad'.
I want the macro to go through all the cells that have the name CV_=CVCAL and do the same thing until there is no more cells named CV_=CVCAL.
Sub If_CV()
Range("A1").Select
Set FoundItem = Range("C1:C1000").Find("CV_=CVCAL")
FoundItem.Offset(columnOffset:=1).Select
If ActiveCell.Value >= 1.5 Then
ActiveCell.Style = "Bad"
End If
End Sub
Sounds like you want to loop through your values.
Determine the end of your range
Loop through your range and check your criteria
Sub If_CV()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long, i As Long
lr = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
For i = 2 To lr
If ws.Range("C" & i) = "CV_=CVCAL" Then
If ws.Range("D" & i) >= 1.5 Then
ws.Range("D" & i) = "Bad"
End If
End If
Next i
End Sub
A basic loop would be simpler:
Sub If_CV()
Dim c As Range, ws As Worksheet
For Each ws in ActiveWorkbook.Worksheets
For Each c in ws.Range("C1:C1000").Cells
If c.Value = "CV_=CVCAL" Then
With c.offset(0, 1)
If .Value >= 1.5 Then .Style = "Bad"
End With
End If
Next ws
Next c
End Sub
*EDIT
Here is what ended up kind of working. The solutions below do not run the AddProj when new row is inserted.
Sub Worksheet_Calculate()
Dim X As Range
Set X = LastCell 'The X is superflous, you could just use the LastCell variable
If Sheet5.Range("A" & Rows.Count).Value < X.Value Then
X.Value = Me.Range("A" & Rows.Count).Value
AddProj
End If
End Sub
Module 1 contains the following:
Function LastCell() As Range
With Sheet5
Set LastCell = .Cells(Rows.Count, 1).End(xlUp)
End With
End Function
Sub AddProj()
Sheet1.Range("Master").Copy Sheet1.Range("C" & Rows.Count).End(xlUp).Offset(1)
End Sub
I am trying to read the data in the last cell of a column.
The value of "X" should be the value of this last cell.
I then want "X" to be compared to the number of rows and if the number of rows is less than "X", perform my macro "AddProj".
Once "X" and Column A are the same value, nothing else is to be done.
For some reason, it is not working.
This code is on the worksheet where I want the comparison to be made.
Please see my code below:
Private Sub Worksheet_Calculate()
X = LastCell
If Sheet5.Range("A" & Rows.Count).Value < Sheet5.Range("X").Value Then
Sheet5.Range("X").Value = Me.Range("A" & Rows.Count).Value
AddProj
End If
End Sub
Sub LastCell()
Range("A1").End(xlDown).Select
End Sub
The "AddProj" is a module that is referenced in the code above (thank you #jsheeran #SJR ACyril for help):
Sub AddProj()
Sheet1.Range("Master").Copy Sheet1.Range("C" & Rows.Count).End(xlUp).Offset(1)
End Sub
Thanks in advance.
Try this:
Sub Worksheet_Calculate()
Dim lRow As Long
lRow = Sheet5.Cells(Sheet5.Rows.Count, 1).End(xlUp).Row
If Sheet5.Cells(lRow, 1) > lRow Then
Sheet5.Cells(lRow, 1) = lRow
AddProj
End If
End Sub
X is a variable but you refer to it as "X". Also avoid using .Select as it is not necessary and even in this case just does nothing, because first of all a Sub cannot return a value and second .Select has also no return value. The best way to calculate the last row is this: Sheet5.Cells(Sheet5.Rows.Count, 1).End(xlUp).Row
Here is just a slight variation on UPGs great answer.
Dim lRow As Long
lRow = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
If lRow >= Sheet1.Cells(lRow, 1) Then
Exit Sub
Else: AddProj
End If
I'm trying to make a program in the Excel VBA that inserts a formula into a column of cells. This formula changes based on the contents of the cell directly to the left.
This is the code I have written so far:
Sub Formula()
Dim colvar As Integer
colvar = 1
Dim Name As String
Name = "Sample, J."
Do While colvar <= 26
colvar = colvar + 1
Name = Range("B" & colvar).Value
Range("C" & colvar).Value = "='" & Name & "'!N18"
Loop
End Sub
As you can see, I want to insert the variable Name between the formula strings, but Excel refuses to run the code, giving me a "application-defined or object-defined error."
Is there a way to fix this?
You will need some error checking in case the sheets don't actually exist in the workbook.
it looks like you are looping through column B that has a list of sheet names and want range N18 to display next to it.
Something like
Sub Button1_Click()
Dim Lstrw As Long, rng As Range, c As Range
Dim Name As String
Lstrw = Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range("B1:B" & Lstrw)
For Each c In rng.Cells
Name = c
c.Offset(, 1) = "='" & Name & "'!N18"
Next c
End Sub
Or you can just list the sheets and show N18 next to it, run this code in a Sheet named "Sheet1"
Sub GetTheSh()
Dim sh As Worksheet, ws As Worksheet
Set ws = Sheets("Sheet1")
For Each sh In Sheets
If sh.Name <> ws.Name Then
ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1) = sh.Name
ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(0, 1) = sh.Range("N18")
End If
Next sh
End Sub
Thank you to everyone for your help! I actually found that I had just made a silly error: the line Do While colvar<=26 should have been Do While colvar<26. The cells were being filled, but the error manifested because one cell was being filled by a nonexistent object.
I did decide to use the .Formula modifier rather than .Value. Thank you to Jeeped for suggesting that.
I am using VBA to run a set of data against five "rule" columns stored in another sheet in the workbook. Put simply, I seem to have code which works, but the VBA use of Selection.Formula = returns "False" when an cell formula would return #N/A or #VALUE. It's critical that I get the error values because it tells the user something different than "False". False should mean that column C (see picture of calculation tab below) doesn't pass the rule. The error values mean that either column B is not found with VLookup in the Rules column or the rule was written incorrectly.
Here's what I have so far:
Sub Build_Formulas_v2()
Application.Calculation = xlManual
Range("a2", Range("a65536").End(xlUp)).Offset(0, 6).Select
Selection.Value = _
Evaluate("(""=""&SUBSTITUTE(VLOOKUP(B2,'Logic Statements'!A:E,4,FALSE),""ZZZ"",""c""&ROW()))")
End Sub
Any help would be tremendously appreciated - my VBA knowledge is still growing and is too basic to understand what I'm up against.
I believe you are using Excel 2003. You should never hard code values like A65536. You can get undesirable results in xl2007+ as they have 1048576 rows.
Is this what you are trying?
Sub Build_Formulas_v2()
Dim lRow As Long
Dim ws As Worksheet
Application.Calculation = xlManual
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A2:A" & lRow).Offset(0, 6).Formula = _
"=SUBSTITUTE(VLOOKUP(B2,'Logic Statements'!A:E,4,FALSE),""ZZZ"",""c""&ROW())"
'~~> Uncomment the below in case you want to replace formulas with values
'.Range("A2:A" & lRow).Offset(0, 6).Value = .Range("A2:A" & lRow).Offset(0, 6).Value
End With
End Sub
Or if you do not want to use .Offset, then you can directly address Column G
Sub Build_Formulas_v2()
Dim lRow As Long
Dim ws As Worksheet
Application.Calculation = xlManual
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("G2:G" & lRow).Formula = _
"=SUBSTITUTE(VLOOKUP(B2,'Logic Statements'!A:E,4,FALSE),""ZZZ"",""C""&ROW())"
'~~> Uncomment the below in case you want to replace formulas with values
'.Range("A2:A" & lRow).Offset(0, 6).Value = _
.Range("A2:A" & lRow).Offset(0, 6).Value
End With
End Sub