My code paste the same formula throughout all of the H2 column. I dont see anywhere in the code where it should do that.
Worksheets("sheet1").Activate
Range("F2").Activate
Do Until IsEmpty(ActiveCell)
If ActiveCell.Value <> "" Then
Pickle = ActiveCell.Address
ActiveCell.Offset(0, 2).Select
ActiveCell.Value = "=IF(" + Pickle + " <TODAY(),""Send Reminder"",""Do not Send Reminder"") "
ActiveCell.Offset(0, -2).Select
End If
ActiveCell.Offset(1, 0).Select
Loop
No loop needed. Use .FormulaR1C1
Do not use Activate and Select, they slow down the code
Dim lastrow As Long
With Worksheets("sheet1")
lastrow = .Cells(.Rows.Count, "F").End(xlUp).Row
.Range("H2:H" & lastrow).FormulaR1C1 = "=IF(RC[-2] <TODAY(),""Send Reminder"",""Do not Send Reminder"") "
End With
This puts the formula in all the cells at once and the RC[-2] properly refers to the same row in Column F
Related
I'm trying to add 2 columns with formulas and autofill down to the last row, but I'm getting an
Autofill method of range class failed
when running the code. It breaks at the line that starts with Activecell.Autofill
Sub addColumnsandChange()
Dim LastRow As Integer
'Finds the value of the last row
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Selection.EntireColumn.Insert
Selection.EntireColumn.Insert
ActiveCell.FormulaR1C1 = "YoY% Change"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "3 Year CAGR"
ActiveCell.Offset(1, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=IFERROR((RC[-1]-RC[2])/RC[2],"""")"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=IFERROR((RC[-2]/RC[2])^(1/3)-1,"""")"
ActiveCell.Offset(0, -1).Range("A1:B1").Select
ActiveCell.AutoFill Range("A1:B" & LastRow), Type:=xlFillDefault
Range("A1:B" & LastRow).Select
End Sub
Since incorporating the LastRow variable I have not been able to run the code.
Instead it returns a run-time error
Autofill method of range class failed
when debugging. How should I autofill and end the code?
While it is unclear on where you actually start (e.g. what cell Selection is), I suppose that it could be assumed that you know what you are doing before running the sub procedure. In any event, it is better to .FillDown or simply write the formulas all at once.
Using .FillDown:
Sub addColumnsandChange()
Dim lastRow As Long
'Finds the value of the last row
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
With Selection.Cells(1)
.Resize(lastRow, 2).EntireColumn.Insert
.Offset(0, -2).Resize(1, 2) = Array("YoY% Change", "3 Year CAGR")
.Offset(1, -2).FormulaR1C1 = "=IFERROR((RC[-1]-RC[2])/RC[2], TEXT(,))"
.Offset(1, -1).FormulaR1C1 = "=IFERROR((RC[-2]/RC[2])^(1/3)-1, TEXT(,))"
.Offset(1, -2).Resize(lastRow - 1, 2).FillDown
.Offset(0, -2).Resize(lastRow, 2).Select
End With
End Sub
Writing all formulas at once:
Sub addColumnsandChange()
Dim lastRow As Long
'Finds the value of the last row
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
With Selection.Cells(1)
.Resize(lastRow, 2).EntireColumn.Insert
.Offset(0, -2).Resize(1, 2) = Array("YoY% Change", "3 Year CAGR")
.Offset(1, -2).Resize(lastRow - 1, 2).FormulaR1C1 = "=IFERROR((RC[-1]-RC[2])/RC[2], TEXT(,))"
.Offset(1, -1).Resize(lastRow - 1, 2).FormulaR1C1 = "=IFERROR((RC[-2]/RC[2])^(1/3)-1, TEXT(,))"
.Offset(0, -2).Resize(lastRow, 2).Select
End With
End Sub
You are trying to autofill starting with the first row.
However, the formulas you are trying to copy are on the second row. Your first row contains header text.
Please note: You don't have to Select a cell before changing it's value. Your code would perform much faster if you would leave our those Selects. (And the code would become much easier to read and understand)
I need to copy values only without Formula from sheet to another. The following code does copy but only with Formula. I tried some solutions presented in this site but they give me errors.
For i = 2 To LastRow
'sheet to copy from
With Worksheets("Hoist")
'check column H value before copying
If .Cells(i, 8).Value >= -90 _
And CStr(.Cells(i, 9).Value) <> "Approved" _
And CStr(.Cells(i, 9).Value) <> "" _
And CStr(.Cells(i, 10).Value) = "" Then
'copy row to "display" sheet
.Rows(i).Copy Destination:=Worksheets("display").Range("A" & j)
j = j + 1
End If
End With
Next i
Try changing this line:
.Rows(i).Copy Destination:=Worksheets("display").Range("A" & j)
to this:
.Rows(i).Copy
Worksheets("display").Range("A" & j).PasteSpecial xlPasteValues
This however drops all formatting. To include formatting, you'll need to add another line like:
Worksheets("display").Range("A" & j).PasteSpecial xlPasteFormats
Another option is to enter a working column and use AutoFilter to avoid loops
insert a column in column A
the working column formuka is =AND(I2>-90,AND(J2<>"",J2<>"Approved"),K2="")
filter and copy the TRUE rows
delete working column A
code
Sub Recut()
Dim ws As Worksheet
Dim rng1 As Range
Set ws = Sheets("Hoist")
ws.AutoFilterMode = False
Set rng1 = Range([h2], Cells(Rows.Count, "H").End(xlUp))
ws.Columns(1).Columns.Insert
rng1.Offset(0, -8).FormulaR1C1 = "=AND(RC[8]>-90,AND(RC[9]<>"""",RC[9]<>""Approved""),RC[10]="""")"
With rng1.Offset(-1, -8).Resize(rng1.Rows.Count + 1, 1).EntireRow
.AutoFilter Field:=1, Criteria1:="TRUE"
.Copy Sheets("display").Range("A1")
Sheets("display").Columns("A").Delete
End With
ws.Columns(1).Delete
ws.AutoFilterMode = False
End Sub
Sub CHECKas()
Dim lastrow As Long
Dim lastcol As Long
Dim l As Integer
Dim i As Integer
Dim rname As Constants
Set rngTarg = Selection
lastrow = Sheets("report").Range("B" & Rows.Count).End(xlUp).row
lastcol = Sheets("report").Cells(2, Columns.Count).End(xlToLeft).Column
Sheets("FEBBRAIO").Select
ActiveCell.Offset(0, -3).Copy
Sheets("REPORT").Select
Cells(1, lastcol + 1).PasteSpecial xlPasteAll
Application.CutCopyMode = False
rname = Application.ActiveCell.Value
ActiveCell.Offset(1, 0).Select
For i = 2 To lastrow
ThisWorkbook.Sheets("report").Select
If Range("f2:f" & lastrow) <= Val(CStr(rname.Value)) _
And Range("g2:g" & lastrow) > Val(CStr(rname.Value)) Then
Cells(i, ActiveCell.Column).Value = "1"
Else
Cells(i, ActiveCell.Column).Value = 0
End If
Next i
End Sub
I'm new in VBA and I can't understand how to compare a constant value with each cell in a range("g2:g" & lastrow) and ("f2:f" & lastrow). The constant value is an active cell in my case. For example considering this formula: IF(AND($R$1<G2;$R$1>=f2);1;0 where R$1$ is the active cell of the last not empty column in ROW 1. I need to fill the entire column (that is activecell.column) with the output coming out form this formula.
But the I Got mismatch error in:
If Range("f2:f" & lastrow) <= Val(CStr(rname.Value)) _
And Range("g2:g" & lastrow) > Val(CStr(rname.Value)) Then
Cells(i, ActiveCell.Column).Value = "1"
Else
Cells(i, ActiveCell.Column).Value = 0
End If
I know from the previous question that this error occurs because I'm trying to comparing a single value against an array of values. How can fix this problem?
You have to use
Range("F" & i)
in your code. Same thing applies to other instances of such code.
I wrote the following macro to help me on a VLOOKUP repetitive action.
It works, but I can't manage to run it on several cells at the same time.
I guess there's a code to write at the beginning of the macro.
Help much appreciated ;-)
Sub Croisement_ZANOX_BO()
'
' Croisement_ZANOX_BO Macro
'
'
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC3,BO!C[-18]:C[-11],1,FALSE)"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC3,BO!C[-19]:C[-12],2,FALSE)"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC3,BO!C[-20]:C[-13],3,FALSE)"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC3,BO!C[-21]:C[-14],4,FALSE)"
Selection.NumberFormat = "dd/mm/yy;#"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC3,BO!C[-22]:C[-15],5,FALSE)"
Selection.NumberFormat = "dd/mm/yy;#"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC3,BO!C[-23]:C[-16],6,FALSE)"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC3,BO!C[-24]:C[-17],7,FALSE)"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC3,BO!C[-25]:C[-18],8,FALSE)"
Selection.NumberFormat = "# ##0,00 €"
End Sub
You should avoid the use of .Select/ActiveCell etc as #Makah suggested.
INTERESTING READ
If the formula that you want to use is say =VLOOKUP($C1,BO!D:XFA,N,FALSE) where n is the column number in the formula (based on your above code) and you want to put that from say D1 then use a simple loop like this
Sub Sample()
Dim ws As Worksheet
Dim n As Long, col As Long
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
col = 4 '<~~ For COl D
With ws
For n = 1 To 8
.Cells(1, col).Formula = "=VLOOKUP($C1,BO!D:XFA," & n & ",FALSE)"
col = col + 1
Next n
End With
End Sub
I want this script to check the cells on column A if there is a URL-link in them, and if it is true then perform some cut-paste operations.
String #5 returns error 404, please help to solve this!
Sub xxxxxx()
Worksheets("1 (2)").Activate
For i = 1 To 2200
Range("A" & i).Select
If (cell.Range("A1").Hyperlinks.Count >= 1) Then
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Cut
ActiveCell.Offset(-1, 2).Range("A1").Select
ActiveSheet.Paste
End If
Next i
End Sub
Per #Siddharth Rout post about not using Activate/Select, I've rewritten your code below. No need to check hyperlinks inside the loop every time since it's always checking cell A1
Sub xxxxxx()
Dim ws As Worksheet
Set ws = Worksheets("1 (2)")
Dim LastRow As Long
LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
If (ws.Range("A1").Hyperlinks.Count > 0) Then
For i = 2 To LastRow
Range("A" & i).Offset(-1, 2).Value = Range("A" & i).Value
Range("A" & i).Clear
Next i
End If
End Sub