My error comes at the definition of LR. It is error object required 424. Anyone knows the problem?
Sub
Dim LR As Long
Dim FLR As Long
LR = wb.Sheets("DTH&TPD Claims List").Cells(Row.Count, 2).End(xlUp).Row
FLR = wb.Sheets("DTH&TPD Claims List").Cells(Row.Count, 1).End(xlUp).Row + 1
wb.Sheets("DTH&TPD Claims List").Cells(FLR, 1).Value = "19"
wb.Sheets("DTH&TPD Claims List").Cells(FLR, 1).Select
Selection.AutoFill Destination:=Range("A" & FLR & ":" & "A" & LR)
End Sub
After Rectification:
There is Error in Selection.Autofill in the Below code now.
Sub tst()
Dim LR As Long
Dim FLR As Long
Dim wb As Workbook
Set wb = ActiveWorkbook 'assuming you want your code to run in
With wb.Sheets("DTH&TPD Claims List")
LR = .Cells(.Rows.Count, 2).End(xlUp).row
FLR = .Cells(.Rows.Count, 1).End(xlUp).row + 1
.Cells(FLR, 1).Value = "19"
.Cells(FLR, 1).Select
Msgbox LR & " " & FLR
Selection.AutoFill Destination:=.Range("A" & FLR & ":A" & LR)
End With
End Sub
Problems:
No declaration of wb
Wrong formula row.count
Try this:
Sub tst()
Dim LR As Long
Dim FLR As Long
Dim wb As Workbook
Set wb = ActiveWorkbook 'assuming you want your code to run in
With wb.Sheets("DTH&TPD Claims List")
LR = .Cells(.Rows.Count, 2).End(xlUp).row
FLR = .Cells(.Rows.Count, 1).End(xlUp).row + 1
.Cells(FLR, 1).Value = "19"
.Cells(FLR, 1).Select
Msgbox LR & " " & FLR
Selection.AutoFill Destination:=.Range("A" & FLR & ":A" & LR)
End With
End Sub
I have cleaned up your code as well.
Related
I am copying data from two workbooks to another workbook.
The code written by me works and serves the purpose.
I am having difficulty getting the syntax for using the offset method to copy to next empty row after the first paste.
With wsdly
lrowdly = Cells(Rows.Count, 2).End(xlUp).Row
.Range("A2:O" & lrowdly).ClearContents
wsb.Range("A2:O" & lrowb).Copy .Range("A2")
End With
With wsdly
lrowdly2 = Cells(Rows.Count, 2).End(xlUp).Row
lrowdly3 = lrowdly2 + 1
wsn.Range("A2:O" & lrown).Copy .Range("A" & lrowdly3)
End With
Whole program.
Sub copy_bond_dat()
Dim wbb As Workbook
Dim wbn As Workbook
Dim wbdly As Workbook
Dim wsb As Worksheet
Dim wsn As Worksheet
Dim wsdly As Worksheet
Set wbb = Workbooks("BSE_BOND.xlsm")
Set wbn = Workbooks("NSE_BOND.xlsm")
Set wbdly = Workbooks("Dly_Debt_Trnx_2022_TMP.xlsx")
Set wsb = wbb.Worksheets("BSEDATA")
Set wsn = wbn.Worksheets("NSEDATA")
Set wsdly = wbdly.Worksheets("Dly_Debt_Trnx_2022_TMP")
Dim lrowb As Long
Dim lrown As Long
Dim lrowdly As Long
Dim lrowdly2 As Long
Dim lrowdly3 As Long
With wsb
lrowb = Cells(Rows.Count, 2).End(xlUp).Row
End With
With wsn
lrown = Cells(Rows.Count, 2).End(xlUp).Row
End With
With wsdly
lrowdly = Cells(Rows.Count, 2).End(xlUp).Row
.Range("A2:O" & lrowdly).ClearContents
wsb.Range("A2:O" & lrowb).Copy .Range("A2")
End With
With wsdly
lrowdly2 = Cells(Rows.Count, 2).End(xlUp).Row
lrowdly3 = lrowdly2 + 1
wsn.Range("A2:O" & lrown).Copy .Range("A" & lrowdly3)
End With
wbdly.Close
End Sub
Changing the mentioned code lines to following code lines problem gets resolved.
With wsdly
lrowdly = .Cells(Rows.Count, 2).End(xlUp).Row
.Range("A2:O" & lrowdly).ClearContents
wsb.Range("A2:O" & lrowb).Copy .Range("A2")
wsn.Range("A2:O" & lrown).Copy
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End With
I have the following code and I am getting "identifier under cursor not recognized" on all portions within the For loop.
Sub Finalize_Macro()
'
' Finalize all data on the Offer Data worksheet
'
Dim DSheet As Worksheet
Dim PSheet As Worksheet
Dim LastRow As Long
Dim ValCol As Long
Dim DayCol As Long
Dim i As Integer
Set DSheet = Worksheets("Offer Data")
Set PSheet = Worksheets("PivotTable")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
ValCol = PSheet.Cells(2, Columns.Count).End(xlToLeft).Column - 1
DayCol = PSheet.Cells(2, Columns.Count).End(xlToLeft).Column
DSheet.Select
[E1:I1] = [{"Redemption Value", "Redemption Days", "Theo", "Actual", "Rated Days"}]
For i = 2 To LastRow
Cells(i, 5).Formula = "=IFERROR(XLOOKUP(A" & i & ",PivotTable!(A:A),PivotTable!.Columns(" & ValCol & ")),0)"
Cells(i, 6).Formula = "=IFERROR(XLOOKUP(A" & i & ",PivotTable!(A:A),PivotTable!.Columns(" & DayCol & ")),0)"
Cells(i, 7).Formula = "=IFERROR(XLOOKUP(A" & i & ",'Big Query Data'!(B:B),'Big Query Data'!(C:C)),0)"
Cells(i, 8).Formula = "=IFERROR(XLOOKUP(A" & i & ",'Big Query Data'!(B:B),'Big Query Data'!(D:D)),0)"
Cells(i, 9).Formula = "=IFERROR(XLOOKUP(A" & i & ",'Big Query Data'!(B:B),'Big Query Data'!(E:E)),0)"
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
If anyone could help advise why this isn't working, I'd greatly appreciate it!
This is what I ended up using - thanks to ScottCraner & BigBen for the assistance!
Sub Finalize_Macro()
'
' Finalize all data on the Offer Data worksheet
'
Dim DSheet As Worksheet
Dim PSheet As Worksheet
Dim LastRow As Long
Dim ValCol As Long
Dim DayCol As Long
Dim i As Integer
Set DSheet = Worksheets("Offer Data")
Set PSheet = Worksheets("PivotTable")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
ValCol = PSheet.Cells(2, Columns.Count).End(xlToLeft).Column - 1
DayCol = PSheet.Cells(2, Columns.Count).End(xlToLeft).Column
DSheet.Select
[E1:I1] = [{"Redemption Value", "Redemption Days", "Theo", "Actual", "Rated Days"}]
Range("E2:E" & LastRow).Formula2 = "=IFERROR(XLOOKUP($A2,PivotTable!$A:$A,PivotTable!" & PSheet.Columns(ValCol).Address & "),0)"
Range("F2:F" & LastRow).Formula2 = "=IFERROR(XLOOKUP($A2,PivotTable!$A:$A,PivotTable!" & PSheet.Columns(ValCol).Address & "),0)"
Range("G2:G" & LastRow).Formula2 = "=IFERROR(XLOOKUP($A2,'Big Query Data'!$B:$B,'Big Query Data'!$C:$C),0)"
Range("H2:H" & LastRow).Formula2 = "=IFERROR(XLOOKUP($A2,'Big Query Data'!$B:$B,'Big Query Data'!$D:$D),0)"
Range("I2:I" & LastRow).Formula2 = "=IFERROR(XLOOKUP($A2,'Big Query Data'!$B:$B,'Big Query Data'!$E:$E),0)"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I copied a range from one worksheet into the next empty row in another worksheet through below code. But this raise an exception
run-time error 424; 'Object Required'.
Sub copy()
Dim lr1 As Long
lr1 = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet1").Range("A1:A" & lr1).copy
End Sub
Sub paste()
Dim lr2 As Long
lr2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet2").Range("A" & lr2).Offset(1, 0).PasteSpecial.xlValues
End Sub
The error occurs when I run the "Paste" macro. I want to reiterate that the copied range does get pasted in the next empty cell, however this error message get displayed.
Which part of the "Paste" macro triggers this message?
When pasting just values, skip the clipboard:
Sub copy()
Dim lr1 As Long
lr1 = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Dim rng As Range
Set rng = Worksheets("Sheet1").Range("A1:A" & lr1)
Dim lr2 As Long
lr2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet2").Range("A" & lr2).Offset(1, 0).Resize(rng.Rows.Count).Value = rng.Value
End Sub
A single sub and modification:
Sub copypaste()
Dim lr1 As Long, lr2 As Long
lr1 = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet1").Range("A1:A" & lr1).copy
lr2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet2").Range("A" & lr2).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End Sub
I've changed my code as per BigBen's correction to the following;
Sub copy()
Dim lr1 As Long
Dim lr2 As Long
lr1 = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
lr2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet1").Range("A1:A" & lr1).copy
Worksheets("Sheet2").Range("A" & lr2).Offset(1, 0).PasteSpecial paste:=xlPasteValues
End Sub
#Scott Craner: I had two subs as I'm new to vba and it's a way to break down the code so that I can understand what the code is supposed to do, but I guess that can be done with comments.
I'm a total novice with VBA. I have the following code which does a matching exercise and then pastes the relevant values into col. B. my issue is each time the code is used the col will change how can I add this to the module so that it looks for the last cell used in row 1 and pastes the values below.
Sub TransferData()
Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim myname As String
Application.ScreenUpdating = False
lastrow1 = Sheets("Input Sheet").Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow1
myname = Sheets("Input Sheet").Cells(i, "B").Value
Sheets("Data").Activate
lastrow2 = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
For j = 2 To lastrow2
If Sheets("Data").Cells(j, "A").Value = myname Then
Sheets("Input Sheet").Activate
Sheets("Input Sheet").Cells(i, "c").Copy
Sheets("Data").Activate
Sheets("Data").Cells(j, "B").Select
ActiveSheet.PasteSpecial
End If
Next j
Application.CutCopyMode = False
Next i
Application.ScreenUpdating = True
End Sub
any assistance with this would be appreciated.
You can replace your second For j = 2 To lastrow2 with the Match function.
Also, there is no need to Activate the sheets back and fourth all the time, just use fully qualified Ranges instead.
Code
Option Explicit
Sub TransferData()
Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim myname As String
Dim MatchRng As Range
Application.ScreenUpdating = False
j = 2
With Sheets("Input Sheet")
lastrow1 = .Range("B" & .Rows.Count).End(xlUp).Row
' the 2 lines bellow should be outisde the loop
lastrow2 = Sheets("Data").Range("A" & Sheets("Data").Rows.Count).End(xlUp).Row
Set MatchRng = Sheets("Data").Range("A2:A" & lastrow2)
For i = 2 To lastrow1
myname = .Range("B" & i).Value
If Not IsError(Application.Match(myname, MatchRng, 0)) Then '<-- if successful Match
Sheets("Data").Range("B" & j).Value = .Range("C" & i).Value
j = j + 1
End If
Application.CutCopyMode = False
Next i
End With
Application.ScreenUpdating = True
End Sub
I recorded this then added the LR = LastRow to make it dynamic but I can not figure out how to remove all the selections that go on
Also these both do the samething but is one way of writting the array better then the other i.e faster, more stable...
Thanks
Selection.FormulaArray = "=ISNUMBER(MATCH(RC[-5]&RC[-6],R1C1:R" & LR & "C1 & R1C2:R" & LR & "C2,0))"
Selection.FormulaArray = "=ISNUMBER(MATCH(B1&A1,$A$1:$A$" & LR & " & $B$1:$B$" & LR & ",0))"
Recorded Macro
Sub Winding()
Dim ws As Worksheet
Dim Rng As Range
Dim LR As Long
Set ws = Sheets("Unpivot_RegistrationData")
LR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Set Rng = ws.Range("G1").Resize(LR, 1)
Range("G1").Select
Selection.FormulaArray = "=ISNUMBER(MATCH(B1&A1,$A$1:$A$" & LR & " & $B$1:$B$" & LR & ",0))"
Selection.AutoFill Destination:=Rng, Type:=xlFillDefault
End Sub
Firstly, preference for A1 or R1C1 style should be driven by ease of constructing the formula string. There is no diffrence in performance or stability
To remove the Selection try this
Note that I have removed the AutoFill, and applied to formula to the whole range in one step.
Sub Winding()
Dim Rng As Range
Dim LR As Long
With Worksheets("Unpivot_RegistrationData")
LR = .Cells(.Rows.Count, 1).End(xlUp).Row
Set Rng = .Range("G1:G" & LR)
End With
Rng.Cells(1, 1).FormulaArray = _
"=ISNUMBER(MATCH(B1&A1,$A$1:$A$" & LR & " & $B$1:$B$" & LR & ",0))"
Rng.Cells(1, 1).AutoFill Destination:=Rng, Type:=xlFillDefault
End Sub