boukaka
asked on
Runtime error 1004 application defined or object defined error
I have a small macro that is manipulating columns and entering formula's in a couple of cells but for some reason when I try to set the vlookup formula I get a runtime error. (at this line ActiveCell.FormulaR1C1 = Formula)
If I paste the string that is in Formula into the cell manually the formula is fine and works perfectly. Can someone please tell me why I can't paste it in using vba code?
Sub Macro1()
Sheets("Sheet2").Select
Dim Check As String
Check = "D1:D" + CStr(LastRow(Sheets("Sheet 2")))
Columns("A:A").Select
Selection.Cut
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Columns("A:B").Select
Selection.NumberFormat = "@"
Range("D1").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-2 ])"
Selection.AutoFill Destination:=Range(Check)
Sheets("Sheet1").Select
Range("A1").Select
ActiveCell.EntireColumn.In sert
Dim DestRange As String
DestRange = "A3:" + CStr(LastRow(Sheets("Sheet 1")))
Dim Formula As String
Dim Rng As String
Rng = "$D$1:$E$" + CStr(LastRow(Sheets("Sheet 2")))
Formula = "=VLOOKUP(CONCATENATE(C2,D 2),Sheet2! " + Rng + ",2,FALSE)"
Range("A2").Select
ActiveCell.FormulaR1C1 = Formula
Selection.AutoFill Destination:=Range(DestRan ge)
Range("A1").Select
ActiveCell.Value = "NEW_UCID"
Range("B1").Select
ActiveCell.Value = "OLD_UCID"
End Sub
Function LastRow(ws As Object) As Long
Dim rLastCell As Object
On Error GoTo ErrHan
Set rLastCell = ws.Cells.Find("*", ws.Cells(1, 1), , , xlByRows, _
xlPrevious)
LastRow = rLastCell.Row
ErrExit:
Exit Function
ErrHan:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbExclamation, "LastRow()"
Resume ErrExit
End Function
If I paste the string that is in Formula into the cell manually the formula is fine and works perfectly. Can someone please tell me why I can't paste it in using vba code?
Sub Macro1()
Sheets("Sheet2").Select
Dim Check As String
Check = "D1:D" + CStr(LastRow(Sheets("Sheet
Columns("A:A").Select
Selection.Cut
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Columns("A:B").Select
Selection.NumberFormat = "@"
Range("D1").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-2
Selection.AutoFill Destination:=Range(Check)
Sheets("Sheet1").Select
Range("A1").Select
ActiveCell.EntireColumn.In
Dim DestRange As String
DestRange = "A3:" + CStr(LastRow(Sheets("Sheet
Dim Formula As String
Dim Rng As String
Rng = "$D$1:$E$" + CStr(LastRow(Sheets("Sheet
Formula = "=VLOOKUP(CONCATENATE(C2,D
Range("A2").Select
ActiveCell.FormulaR1C1 = Formula
Selection.AutoFill Destination:=Range(DestRan
Range("A1").Select
ActiveCell.Value = "NEW_UCID"
Range("B1").Select
ActiveCell.Value = "OLD_UCID"
End Sub
Function LastRow(ws As Object) As Long
Dim rLastCell As Object
On Error GoTo ErrHan
Set rLastCell = ws.Cells.Find("*", ws.Cells(1, 1), , , xlByRows, _
xlPrevious)
LastRow = rLastCell.Row
ErrExit:
Exit Function
ErrHan:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbExclamation, "LastRow()"
Resume ErrExit
End Function
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Also, your setting of DestRange is forgetting the second :A
DestRange = "A3:" + CStr(LastRow(Sheets("Sheet 1")))
I took out the use of your variables and just put the function call in your macro lines:
DestRange = "A3:" + CStr(LastRow(Sheets("Sheet
I took out the use of your variables and just put the function call in your macro lines:
Sub Macro1()
Sheets("Sheet2").Columns("A").Cut
Sheets("Sheet2").Columns("F").Insert
Sheets("Sheet2").Columns("A:B").NumberFormat = "@"
Sheets("Sheet2").Range("D1:D" & CStr(LastRow(Sheets("Sheet2")))).FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-2])"
Sheets("Sheet1").Columns("A").Insert
Sheets("Sheet1").Range("A1").Value = "NEW_UCID"
Sheets("Sheet1").Range("B1").Value = "OLD_UCID"
Sheets("Sheet1").Range("A2:A" & CStr(LastRow(Sheets("Sheet1")))).Formula = _
"=VLOOKUP(CONCATENATE(C2,D2),Sheet2!$D$1:$E$" & CStr(LastRow(Sheets("Sheet2"))) & ",2,FALSE)"
End Sub
Matt
ASKER
Perfect response! Thank you.
ASKER