Dealing with an issue that seems simple enough, but for some reason I cannot get this to work.
I have a data input sheet I am trying to match values across to another sheet, the values are both in column E, and all the values in column E are unique. The values will always be stored in rows 8 though to 2500.
My code is as below, however is throwing the ever useful 1004 error (Application-Defined or object-defined error), on line
If Sheets("Target Inputs").Range("E" & CStr(LSearchRow)).Value = searchTerm Then
any help would be greatly appreciated:
Sub LOAD_BUID_Lookup()
Dim i As Integer
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim searchTerm As String
On Error GoTo Err_Execute
For i = 8 To 2500
searchTerm = Range("E" & i).Text
If Sheets("Target Inputs").Range("E" & CStr(LSearchRow)).Value = searchTerm Then
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet2 in next row
Sheets("LOAD").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Target Inputs").Select
End If
Next i
Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
没有将LSearchRow
设置为任何值,这意味着它为0。这又引发了异常,因为行号不能为0。而且没有任何理由使用CStr
转换为字符串,因为串联会转换整个范围参数仍然是字符串。
Usually when comparing two different columns in two different sheet you would see a double loop the first to loop through sheet1 and the second to take every value of sheet1 and loop through sheet2 to find a match. In reading your description I think this is what you want.
Double loops can be time intensive. There is another way, Worksheetfunction.match
!!
I also noticed your code selecting/activating sheets multiple times. Typically selecting/activating sheets is not required if you declare and instantiate the variables you need.
Below is an example code I tried to make it as plug and play as possible, but I wasn't sure of the name of the sheet you are looping through. I've tested the code on dummy data and it seems to work, but again I'm not quite positive on the application. I've commented the code to explain as much of the process as possible. Hopefully it helps. Cheers!
Option Explicit 'keeps simple errors from happening
Sub LOAD_BUID_Lookup()
'Declare variables
Dim wb As Workbook
Dim wsInputs As Worksheet
Dim wsTarget As Worksheet
Dim wsLoad As Worksheet
Dim searchTerm As String
Dim matchRng As Range
Dim res
Dim i As Integer
'instantiate variables
Set wb = Application.ThisWorkbook
Set wsInputs = wb.Worksheets("Inputs") 'unsure of the name of this sheet
Set wsTarget = wb.Worksheets("Target Inputs")
Set wsLoad = wb.Worksheets("LOAD")
Set matchRng = wsTarget.Range("E:E")
On Error GoTo Err_Execute
For i = 8 To 2500
searchTerm = wsInputs.Range("E" & i).Text 'can use sheet variable to refer exactly to the sheet you want without selecting
'get match if one exists
On Error Resume Next
res = Application.WorksheetFunction.Match(searchTerm, matchRng, 0) 'will return a row number if there is a match
If Err.Number > 0 Then 'the above command will throw an error if there is no match
'MsgBox "No Match!", vbCritical
Err.Clear ' we clear the error for next time around
On Error GoTo 0 'return to previous error handeling
Else
On Error GoTo 0 'return to previous error handeling
wsInputs.Range("A" & i).EntireRow.Copy Destination:=wsLoad.Range("A" & wsLoad.Range("E50000").End(xlUp).Row + 1) 'gets last row and comes up to last used row ... offset goes one down from that to the next empty row
End If
Next i
'Application.CutCopyMode = False -- there is no need for this when we use "Destination"
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.