I've came across a problem when working with ranges on different worksheets within the same workbook. Let me demonstrate you this on a simple example:
We have two worksheets: Sheet1 and Sheet2. Each has range A1:A3 with some values. After running below code excel is giving me an error 1004 method range of object _worksheet failed
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range, rng2 As Range
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set rng1 = ws1.Range("A1", Range("A1").End(xlDown))
Set rng2 = ws2.Range("A1", Range("A1").End(xlDown))
Related
Trying to loop though the worksheets to apply the filter on date, and copy all the filtered data into a "Report" sheet.
Here is code, which loops only the first sheet ( USD) and not the second one (EUR).
Sub SheetLoop()
Dim Ws As Worksheet
Dim wb As Workbook
Dim DestSh As Worksheet
Dim Rng As Range
Dim CRng As Range
Dim DRng As Range
Set wb = ThisWorkbook
Set DestSh = wb.Worksheets("Report")
Set CRng = DestSh.Range("L1").CurrentRegion
Set DRng = DestSh.Range("A3")
For Each Ws In wb.Worksheets
If Ws.Name <> DestSh.Name Then
Set Rng = Ws.Range("A1").CurrentRegion
Rng.AdvancedFilter xlFilterCopy, CRng, DRng
End If
Next Ws
End Sub
Since AdvancedFilter needs the filtered range headers, you cannot copy only part of the filtered range, but you can delete the first row of the copied range, except the first copied range (from first sheet):
Sub SheetLoop()
Dim Ws As Worksheet, wb As Workbook, DestSh As Worksheet
Dim Rng As Range, CRng As Range, DRng As Range, i As Long
Set wb = ThisWorkbook
Set DestSh = wb.Worksheets("Report")
Set CRng = DestSh.Range("L1").CurrentRegion
Set DRng = DestSh.Range("A3")
For Each Ws In wb.Worksheets
If Ws.name <> DestSh.name Then
i = i + 1
Set Rng = Ws.Range("A1").CurrentRegion
Rng.AdvancedFilter xlFilterCopy, CRng, DRng
If i > 1 Then DRng.cells(1).EntireRow.Delete xlUp 'delete the first row of the copied range, except the first case
Set DRng = DestSh.Range("A" & DestSh.rows.count).End(xlUp).Offset(1) 'reset the range where copying to
End If
Next Ws
MsgBox "Ready..."
End Sub
I'm trying to copy data from sheet "DATEV_RAB_UNVERBINDLICH", Range D2:D to sheet "Ready to upload", Range B2:B.
I would like find data to the last row and then copy them into the other sheet. I have this code:
Sub CopyInvoiceNo()
Dim ws, ws1 As Worksheet
Dim lastrow As Long
lastrow = .Cells(.Rows.Count, "D").End(xlUp).Row
Set ws = Sheets("DATEV_RAB_UNVERBINDLICH")
Set ws1 = Sheets("Ready to upload")
ws.Range("D2" & lastrow).Copy
ws1.Range("B4").PasteSpecial xlPasteValues
ws1.Activate
End Sub
But I receive error msg Invalid or unqualified reference. Could you advise me, what do I do wrong, please?
Two errors in your code
At line 3, this is not the correct way to define multiple variable types in the same line. You have to define each of them.
At line 10, lets say your lastrow is "20". It would set the range to "D220", which is also not what you want.
Sub CopyInvoiceNo()
Dim ws As Worksheet, ws1 As Worksheet
Dim lastrow As Long
Set ws = Sheets("DATEV_RAB_UNVERBINDLICH")
Set ws1 = Sheets("Ready to upload")
lastrow = ws.Cells(Rows.count, 4).End(xlUp).Row
ws.Range("D2:D" & lastrow).Copy
ws1.Range("B4").PasteSpecial xlPasteValues
ws1.Activate
End Sub
I also changed to define the variables and its values at the start of the code. The lastrow bit didn't code here too after a bit of testing. Now it works for me at least.
I'm quite the novice when it comes to vba so bear with me. I have a data set that is variable in column and row length. Each column contains a range of data that I'm trying to use the advanced filter to put out unique cells.
sub uniques()
dim i as integer
dim numcol as integer
dim rng as range
dim ws as worksheet
dim ws2 as worksheet
set ws = sheets("Sheet1") 'data
set ws2 = sheets("Sheet2") 'paste unique per column data
numcol = activesheet.usedrange.columns.count
for i = 1 to numcol
set rng = ws.columns(i)
set rng2 = ws2.columns(i)
ws.rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws2.rng2, unique=True
Next
end sub
I've tried a few different ways but I think this one is the closest. I am eager to learn so any tips are greatly appreciate. Thanks in advance.
I guess my problem was properly setting the copy and paste ranges in the loop. This has worked. I appreciate the comment.
Sub test()
Dim i As Integer
Dim numcol As Integer
Dim rng As Range
Dim ws As Worksheet
Dim ws2 As Worksheet
Set ws = ActiveSheet 'data
Set ws2 = Sheets.Add
numcol = ws.UsedRange.Columns.count
Set rng = ws.UsedRange
For i = 1 To numcol
rng.Columns(i).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws2.Columns(i), Unique:=True
Next
End Sub
I want to copy data from one workbook to another based on a shared unique identifier. I would like to loop through the cells in Column BP in Workbook 1, starting with Row 4, finding the matching cell value in Column BQ, starting with Row 6, of Workbook 2 and copying data associated that unique identifier from Workbook 2 to Workbook 1. My code is below, I'm getting a 'subscript out of range' error. I think it has to do with my DataCopy and DataPaste ranges, I want them to refer to the Row of the unique identifier in the for loop. I would appreciate any pointers that get me moving along. Thanks.
Sub cmdUpdate_Click()
Dim LastRow As Long
Dim Key1 As Range, Key2 As Range, DataCopy As Range, DataPaste As Range, Cell As Range, Cell2 As Range
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Set wb1 = Workbooks("File Name")
Set wb2 = Workbooks.Open("File Path", ReadOnly:=True)
Set ws1 = wb1.Sheets("Sheet1")
Set ws2 = wb2.Sheets("Sheet1")
LastRow = xlLastRow
Set Key1 = ws1.Range("BP6:BP" & LastRow)
Set Key2 = ws2.Range("BQ4:BQ" & LastRow)
Set DataCopy = ws2.Range("P:BK")
Set DataCopy = ws1.Range("P:BK")
For Each Cell In Key1
Set Cell2 = Key2.Find(what:=Cell.Value, LookIn:=xlValues)
If Not Cell2 Is Nothing Then
Rows.Range(DataCopy).Copy
Rows.Range(DataPaste).PasteSpecial Paste:=xlPasteValues
End If
Next
End Sub
Function xlLastRow(Optional WorksheetName As String) As Long
' find the last populated row in a worksheet
If WorksheetName = vbNullString Then WorksheetName = ActiveSheet.Name
With Worksheets(WorksheetName)
On Error Resume Next
xlLastRow = .Cells.Find("*", .Cells(1), xlFormulas, _
xlWhole, xlByRows, xlPrevious).Row
If Err <> 0 Then xlLastRow = 0
End With
End Function
I have two worksheets, in the second worksheet i have defined all the parameters unique name
in the first sheet i have defined the just the parameters name, on the click of Auto Fill Button i want it to go and check all the parameters name in the Acronym sheet and if the match is found it should replace the particular parameter's unique id.
Could anyone please tell me how to achieve this using excel VBA, Any help is appreciated!
Loop through one to find the other.
Sub DoIt()
Dim sh As Worksheet, ws As Worksheet
Dim LstRw As Long, rng As Range, c As Range, Frng As Range
Set sh = Sheets("Sheet1") 'Acronym Sheet
Set ws = Sheets("Sheet2")
With sh
LstRw = .Cells(.Rows.Count, "B").End(xlUp).Row
Set rng = .Range("B2:B" & LstRw)
End With
With ws
For Each c In rng.Cells
Set Frng = .Range("C:C").Find(what:=c, lookat:=xlWhole)
If Not Frng Is Nothing Then
Frng.Value = c.Offset(, -1).Value
Else:
End If
Next c
End With
End Sub