I have three sheet, Sheet1 , sheet2, and sheet3.
Sheet3 is my result sheet.
I have the ID in column E of sheet3, copied from Column P of sheet1. I compare the ID of sheet3, with ID of sheet2. I am successful.
but, i have an issue while comparing. The ID are generally 11 to 13 Digit Long.
Case1, in few cases i have id in sheet 3 as D2C12682300 and in sheet2 the same ID as D2C1268230000, in this case, i want them to be matched, but according to my code, it is not getting matched.
Case2, in somecase i have the id in sheet3 as D2C12682300_id4576901 and in the sheet2 i have the same id as D2C1268230000. I want them to be matched, but my code is not working this way.
Could someone suggest, how i could include These condition in my code.I am struck how to do it.
Below is the code, i am using to look for id from sheet3 to sheet2. I want to include These cases in this code.
Sub lookup()
Dim lLastRow As Long
Dim rng As Range
Dim i As Long
'Copy lookup values from sheet1 to sheet3
ThisWorkbook.Sheets("S").Select
lLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
Range("P5:P" & lLastRow).Copy Destination:=Sheets("Result").Range("E5")
Range("G5:G" & lLastRow).Copy Destination:=Sheets("Result").Range("H5")
'Go to the destination sheet
Sheets("Result_").Select
For i = 5 To lLastRow
'Search for the value on sheet2
Set rng = Sheets("P").UsedRange.Find(Cells(i, 5).Value)
'If it is found put its value on the destination sheet
If Not rng Is Nothing Then
Cells(i, 6).Value = rng.Value
Cells(i, 1).Value = rng.Offset(0, 1).Value
Cells(i, 2).Value = rng.Offset(0, 2).Value
Cells(i, 3).Value = rng.Offset(0, 3).Value
Cells(i, 4).Value = rng.Offset(0, 9).Value
Cells(i, 9).Value = rng.Offset(0, 10).Value
Cells(i, 12).Value = rng.Offset(0, 6).Value
Cells(i, 13).Value = rng.Offset(0, 5).Value
Cells(i, 14).Value = rng.Offset(0, 8).Value
End If
Next i
End Sub
Use a Wildcard:
Set rng = Sheets("P").UsedRange.Find(Cells(i, 5).Value & "*", LookAt:=xlWhole)
Also avoid using .Select and objectify .Range, .Cells etc. Read How to Avoid Select.
Related
I have three sheets, sheet S, Sheet P and Sheet Data.
I first copy the column of Sheet S to Sheet Data. Then in column E of sheet Data, I look for the ID. The ID In column E of data sheet, matches with the column A of P sheet, then I copy the corresponding ID.
The problem here is the Sheet data contains 214 rows, while sheet P contains 1110.
while comparing the ID, there are two different ID from row 870 and 871, which are not copied, even though they are same.
Could someone guide what could be the reason ?
Sub lookup()
Dim lLastrow, totalrows As Long
Dim rng As Range
Dim i As Long
'Copy lookup values from S to Data
With Sheets("S")
lLastrow = .Cells(.Rows.count, 1).End(xlUp).Row
.Range("P5:P" & lLastrow).Copy Destination:=Sheets("Data").Range("E5")
.Range("G5:G" & lLastrow).Copy Destination:=Sheets("Data").Range("H5")
End With
totalrows = Sheets("P").Cells(Sheets("P").Rows.count, "A").End(xlUp).Row
For i = 5 To lLastrow
'Search for the value on P_APQP
With Sheets("P")
Set rng = .Columns(1).Find(Sheets("Data").Cells(i, 5).Value & "*", lookat:=xlWhole)
End With
'If it is found put its value on the destination sheet
If Not rng Is Nothing Then
With Sheets("Data")
.Cells(i, 6).Value = rng.Value
.Cells(i, 1).Value = rng.Offset(0, 1).Value
.Cells(i, 2).Value = rng.Offset(0, 2).Value
.Cells(i, 3).Value = rng.Offset(0, 3).Value
.Cells(i, 4).Value = rng.Offset(0, 9).Value
.Cells(i, 9).Value = rng.Offset(0, 10).Value
.Cells(i, 13).Value = rng.Offset(0, 6).Value
.Cells(i, 14).Value = rng.Offset(0, 5).Value
.Cells(i, 15).Value = rng.Offset(0, 4).Value
.Cells(i, 16).Value = rng.Offset(0, 8).Value
End With
End If
Next i
End Sub
I'll post the whole code. I also made an adjustment to your first line of declarations - as you had it, only totalrows was being declared as Long. You have to spell each one out I'm afraid.
Sub lookup()
Dim lLastrow As Long, totalrows As Long
Dim rng As Range
Dim i As Long
With Sheets("S")
lLastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("P5:P" & lLastrow).Copy Destination:=Sheets("Data").Range("E5")
.Range("G5:G" & lLastrow).Copy Destination:=Sheets("Data").Range("H5")
End With
totalrows = Sheets("P").Cells(Sheets("P").Rows.Count, "A").End(xlUp).Row
For i = 5 To lLastrow
'Search for the value on P_APQP
With Sheets("P")
'amended below
Set rng = .Columns(1).Find(Trim(Sheets("Data").Cells(i, 5).Value) & "*", lookat:=xlWhole)
End With
'If it is found put its value on the destination sheet
If Not rng Is Nothing Then
With Sheets("Data")
.Cells(i, 6).Value = rng.Value
.Cells(i, 1).Resize(, 3).Value = rng.Offset(0, 1).Value
.Cells(i, 2).Value = rng.Offset(0, 2).Value
.Cells(i, 3).Value = rng.Offset(0, 3).Value
.Cells(i, 4).Value = rng.Offset(0, 9).Value
.Cells(i, 9).Value = rng.Offset(0, 10).Value
.Cells(i, 13).Value = rng.Offset(0, 6).Value
.Cells(i, 14).Value = rng.Offset(0, 5).Value
.Cells(i, 15).Value = rng.Offset(0, 4).Value
.Cells(i, 16).Value = rng.Offset(0, 8).Value
End With
End If
Next i
End Sub
I have three Sheets, sheet1 , sheet2 and sheet3.
I am trying to copy the sheet 1, column N and F in sheet3.
Then, With this ID,I look into column A and see if they are matching,
If so then I copy the Matched ID to sheet3.
I am using below code, for this reason.
the code was working fine till now. But I update my sheet2 today morning, and due to some reason, the code is Keep on executing for a Long time and still i am not able to get the Output, I am unable to figure out the reason for this.
I tried to debug and the line below was highlighted.
If Not rng Is Nothing Then
In Addition, I am using an button in the worksheet and calling the functions like
call thisworkbook.lookup
similarly i have 6 other functions, attached to this button.
Here is the complete code. Could someone help me to figure out what is the reason for this .
Sub lookup()
Dim totalrows As Long
Dim Totalcolumns As Long
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim i As Long
'Copy lookup values from sheet1 to sheet3
Sheets("S1").Select
totalrows = ActiveSheet.UsedRange.Rows.Count
Totalcolumns = ActiveSheet.UsedRange.Columns.Count
'TotalRows = 441
'Totalcolumns = 392
Range("N5:N" & totalrows).Copy Destination:=Sheets("s3").Range("E5")
Range("F5:F" & totalrows).Copy Destination:=Sheets("s3").Range("H5")
'Go to the destination sheet
Sheets("s3").Select
For i = 5 To totalrows
'Search for the value on sheet2
Set rng = Sheets("s2").UsedRange.Find(Cells(i, 5).Value)
'If it is found put its value on the destination sheet
If Not rng Is Nothing Then
Cells(i, 6).Value = rng.Value
Cells(i, 1).Value = rng.Offset(0, 1).Value
Cells(i, 2).Value = rng.Offset(0, 2).Value
Cells(i, 3).Value = rng.Offset(0, 3).Value
Cells(i, 4).Value = rng.Offset(0, 9).Value
Cells(i, 9).Value = rng.Offset(0, 10).Value
Cells(i, 12).Value = rng.Offset(0, 6).Value
Cells(i, 13).Value = rng.Offset(0, 5).Value
Cells(i, 14).Value = rng.Offset(0, 8).Value
End If
Next
End Sub
The issue was caused by the UserdRange of the worksheet S1 being way beyond its true size.
Problem solved by:
Find the last row in your spreadsheet S1 that contains data.
select the cell below that row.
Press control+shift+End on your keyboard.
Right-click in that range and select Delete.
Choose Delete Entire rows.
Save file
I am having 4 sht, sht1, sht2, sht3 and sht4.
I am copying the columns E and F from sht 1 to sht3. and then i look into the corresponding values in sht 2, and paste them in sht3.
I then lookinto in my sht3, if the column "G" has "NO"; then i copy the corresponding rows to sht4.
till, this i have completed coding.
I wanted to look into the column E in sht4, and paste the corresponding ID from sht1. Could someone tell, how i could do it ?
EDIT.
In sht3, i have the rows filled only when there is Id in column F.
In few cases, i dont have column F,means there is no ID.
so, i copy them to sht4. Now i have in sht4, column E Filled. I want to look into the relevant Information of those ID in sht1. I want the Information from each and every column in sht1, except E .
I know we can use Offset, but how do I use it in this case,
I have tried the following code
Sub nlookup()
Dim i As Long
Dim totalrows As Long
Dim rng As Range
Sheets("sht1").Select
totalrows = ActiveSheet.UsedRange.Rows.Count
Sheets("sht4").Select
For i = 5 To totalrows
Set rng = Sheets("sht2").UsedRange.Find(Cells(i, 5).Value)
'If it is found put its value on the destination sheet
If Not rng Is Nothing Then
Cells(i, 6).Value = rng.Value
Cells(i, 1).Value = rng.Offset(0, 0).Value
Cells(i, 2).Value = rng.Offset(0, 14).Value
Cells(i, 3).Value = rng.Offset(0, 1).Value
Cells(i, 4).Value = rng.Offset(0, 2).Value
Cells(i, 12).Value = rng.Offset(0, 8).Value
Cells(i, 13).Value = rng.Offset(0, 9).Value
End If
Next
End Sub
Set rng = Sheets("sht2").UsedRange.Find(Cells(i, 5).Value), there is no Need of looking into this line, i beleive.
The code will consider the following as discussed in chat:
Data should be copied from sht1 to sht4 on Id's in both sheets
Id's are in Column L and Column E for sht1 and sht4 respectively
Columns to be copy from sht1 to sht4 as A->A, B->C,C->D,I->L,J->M,O->B
Data in sht1 and sht4 starts from Row 5 and Row 2 respectively
Sub Demo()
Dim srcLastRow As Long, destLastRow As Long
Dim srcWS As Worksheet, destWS As Worksheet
Dim i As Long, j As Long
Application.ScreenUpdating = False
Set srcWS = ThisWorkbook.Sheets("Sht1")
Set destWS = ThisWorkbook.Sheets("Sht4")
srcLastRow = srcWS.Cells(srcWS.Rows.Count, "L").End(xlUp).Row
destLastRow = destWS.Cells(destWS.Rows.Count, "E").End(xlUp).Row
For i = 2 To destLastRow
For j = 5 To srcLastRow
If destWS.Cells(i, "E").Value = srcWS.Cells(j, "L").Value Then
destWS.Cells(i, "A") = srcWS.Cells(j, "A")
destWS.Cells(i, "B") = srcWS.Cells(j, "O")
destWS.Cells(i, "C") = srcWS.Cells(j, "B")
destWS.Cells(i, "D") = srcWS.Cells(j, "C")
destWS.Cells(i, "L") = srcWS.Cells(j, "I")
destWS.Cells(i, "M") = srcWS.Cells(j, "J")
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
Why not just use Cells(i, 4).Value = rng.Cells(i, 6).Value ?
Also get rid of the.Select
Sub nlookup()
dim sht as Worksheet
Dim i As Long
Dim totalrows As Long
Dim rng As Range
totalrows = Sheets("sht1").UsedRange.Rows.Count
Set sht = Worksheets("sht4")
For i = 5 To totalrows
Set rng = Sheets("sht2").UsedRange.Find(sht.Cells(i, 5).Value)
'If it is found put its value on the destination sheet
If Not rng Is Nothing Then
sht.Cells(i, 6).Value = rng.Value
sht.Cells(i, 1).Value = rng.Cells(i, 1).Value
sht.Cells(i, 2).Value = rng.Cells(i, 16).Value
sht.Cells(i, 3).Value = rng.Cells(i, 4).Value
sht.Cells(i, 4).Value = rng.Cells(i, 6).Value
sht.Cells(i, 12).Value = rng.Cells(i, 20).Value
sht.Cells(i, 13).Value = rng.Cells(i, 22).Value
End If
Next
End Sub
I receive Runtime Error '13': Type Mismatch when I try to run the code. Debug highlights the 'IF' statements, but I can't figure out where the mistake is. Any help would be appreciated. Thanks
Dim i As Integer
Dim lastRow As Long
Workbooks("Template Part_II.xlsx").Worksheets(2).Activate
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
If Cells(i, 1).Value <> "#N/A" And Cells(i, 1).Value <> "00000000-000" Then
Cells(i, 1).Copy
Worksheets(1).Range("A2:A" & lastRow).PasteSpecial xlPasteValues
End If
Next I
and in fact I'm trying to do this:
I have one Sheet where I have 100 Rows of various IDs and I want to copy this IDs to another sheet without possible non ID strings in this case it can be #N/A or 00000000-0000, also I don't want those non copied cells to appear as blanks in destination range.
Wrap your accesses to the cell inside a check which ensures the cell contains no error value (e.g. a cell 'containing' a division by 0) like so
...
For i = 2 To lastRow
If Not IsError(Cells(i, 1).Value) Then
If Cells(i, 1).Value <> "#N/A" And Cells(i, 1).Value <> "00000000-000" Then
Cells(i, 1).Copy
Worksheets(1).Range("A2:A" & lastRow).PasteSpecial xlPasteValues
End If
End If
Next i
...
Note: I tried to insert the condition at the front of the existing If but it seems VBA does not use short-circuiting therefore the wrapping
Update due to comment
You may want to change your code like this
Dim i As Integer
Dim lastRow As Long
Dim targetRow As Long
Workbooks("Template Part_II.xlsx").Worksheets(2).Activate
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
targetRow = 2
For i = 2 To lastRow
If Not IsError(Cells(i, 1).Value) Then
If Cells(i, 1).Value <> "#N/A" And Cells(i, 1).Value <> "00000000-000" Then
Cells(i, 1).Copy
Worksheets(1).Cells(targetRow, 1).PasteSpecial xlPasteValues
targetRow = targetRow + 1
End If
End If
Next i
Here's my code. This compares 2 columns from different sheets (2 sheets) and then reflect the answer in another sheets but it fails to show the data that has no match. I came across an error that says Run Time '91': Object variable r With block variable not set.
Here's the code. Please help.
Sub lookup()
Dim TotalRows As Long
Dim rng As Range
Dim i As Long
'Copy lookup values from sheet1 to sheet3
Sheets("Sheet1").Select
TotalRows = ActiveSheet.UsedRange.Rows.Count
Range("A1:A" & TotalRows).Copy Destination:=Sheets("Sheet3").Range("A1")
'Go to the destination sheet
Sheets("Sheet3").Select
For i = 1 To TotalRows
'Search for the value on sheet2
Set rng = Sheets("Sheet2").UsedRange.Find(Cells(i, 1).Value)
'If it is found put its value on the destination sheet
If Not rng Is Nothing Then
Cells(i, 2).Value = rng.Value
Else
Cells(i, 4).Value = rng.Value <------------stops here
End If
Next
End Sub
You are trying to assign Nothing to a cell if no match is found:
If Not rng Is Nothing Then
Cells(i, 2).Value = rng.Value 'rng has a value
Else
Cells(i, 4).Value = rng.Value 'rng has NO value, ie is Nothing
End If
This is not possible and that's why you get the error.
Change this:
Cells(i, 4).Value = rng.Value
To this:
Cells(i, 4).Value = "Not found"