VBA code to find value in once sheet and paste it in another sheet

Tanyaann1995

Board Regular
Joined
Mar 24, 2021
Messages
62
Office Version
  1. 2016
Platform
  1. Windows
Hi,

In sheet 2, when I write a part number in column E24, I want the code to find that part in Sheet 3. Please see attached pictures of how both the sheets look like.
The below is my code but an error message "Application or object defined error" keeps popping up after the first For loop. Pls check and advise.

VBA Code:
Sub Price()

Dim pno As Double
Dim LastRow As Long
Dim i As Integer
Dim LastRowinMainSheet As Long
Dim j As Integer

LastRowinMainSheet = Cells.Find(What:="*", _
                    After:=Range("E23"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row

LastRow = Worksheets(3).UsedRange.SpecialCells(x1CellTypeLastCell).Row

For j = 24 To LastRowinMainSheet
Worksheets(2).Cells(j, 5).Value = pno

For i = 3 To LastRow

If Worksheets(3).Cells(i, 2).Value = pno Then
Worksheets(3).Cells(i, 3).Copy
Worksheets(2).Cells(j, 4).PasteSpecial xlPasteValues
Worksheets(3).Cells(i, 4).Copy
Worksheets(2).Cells(j, 6).PasteSpecial xlPasteValues
Worksheets(3).Cells(i, 5).Copy
Worksheets(2).Cells(j, 7).PasteSpecial xlPasteValues
Worksheets(3).Cells(i, 14).Copy
Worksheets(2).Cells(j, 12).PasteSpecial xlPasteValues
End If

Next i

Next j


End Sub
 

Attachments

  • Capture9.PNG
    Capture9.PNG
    27.5 KB · Views: 9
  • Capture10.PNG
    Capture10.PNG
    53.1 KB · Views: 8
Last edited by a moderator:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Hi & welcome to MrExcel.
Try it like
VBA Code:
Sub Price()

Dim pno As String
Dim LastRow As Long
Dim i As Integer
Dim LastRowinMainSheet As Long
Dim j As Integer

LastRowinMainSheet = Cells.Find(What:="*", _
                    After:=Range("E23"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row

LastRow = Worksheets(3).UsedRange.SpecialCells(xlCellTypeLastCell).Row

For j = 24 To LastRowinMainSheet
   pno = Worksheets(2).Cells(j, 5).Value
   
   For i = 3 To LastRow
   
      If Worksheets(3).Cells(i, 2).Value = pno Then
         Worksheets(2).Cells(j, 4).Value = Worksheets(3).Cells(i, 3).Value
         Worksheets(2).Cells(j, 6).Value = Worksheets(3).Cells(i, 4).Value
         Worksheets(2).Cells(j, 7).Value = Worksheets(3).Cells(i, 5).Value
         Worksheets(2).Cells(j, 12).Value = Worksheets(3).Cells(i, 14).Value
      End If
   
   Next i

Next j


End Sub
 
Upvote 0
Hi & welcome to MrExcel.
Try it like
VBA Code:
Sub Price()

Dim pno As String
Dim LastRow As Long
Dim i As Integer
Dim LastRowinMainSheet As Long
Dim j As Integer

LastRowinMainSheet = Cells.Find(What:="*", _
                    After:=Range("E23"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row

LastRow = Worksheets(3).UsedRange.SpecialCells(xlCellTypeLastCell).Row

For j = 24 To LastRowinMainSheet
   pno = Worksheets(2).Cells(j, 5).Value
  
   For i = 3 To LastRow
  
      If Worksheets(3).Cells(i, 2).Value = pno Then
         Worksheets(2).Cells(j, 4).Value = Worksheets(3).Cells(i, 3).Value
         Worksheets(2).Cells(j, 6).Value = Worksheets(3).Cells(i, 4).Value
         Worksheets(2).Cells(j, 7).Value = Worksheets(3).Cells(i, 5).Value
         Worksheets(2).Cells(j, 12).Value = Worksheets(3).Cells(i, 14).Value
      End If
  
   Next i

Next j


End Sub
Hi, thanks for the revised code. But, this time, there is no result appearing when I run this code. Please advise.
 
Upvote 0
Hi
I suggest to use sheets name instead of sheets code name
 
Upvote 0
This Fluff code with the suggest
VBA Code:
Sub Price()

Dim pno As String
Dim LastRow As Long
Dim i As Integer
Dim LastRowinMainSheet As Long
Dim j As Integer

LastRowinMainSheet = Cells.Find(What:="*", _
                    After:=Range("E23"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row

LastRow = Sheets("Pricelist").UsedRange.SpecialCells(xlCellTypeLastCell).Row

For j = 24 To LastRowinMainSheet
   pno = Sheets("Emerson COMMERCIAL OFFER").Cells(j, 5).Value
   
   For i = 3 To LastRow
   
      If Sheets("Pricelist").Cells(i, 2).Value = pno Then
         Sheets("Emerson COMMERCIAL OFFER").Cells(j, 4).Value = Sheets("Pricelist").Cells(i, 3).Value
         Sheets("Emerson COMMERCIAL OFFER").Cells(j, 6).Value = Sheets("Pricelist").Cells(i, 4).Value
         Sheets("Emerson COMMERCIAL OFFER").Cells(j, 7).Value = Sheets("Pricelist").Cells(i, 5).Value
         Sheets("Emerson COMMERCIAL OFFER").Cells(j, 12).Value = Sheets("Pricelist").Cells(i, 14).Value
      End If
   
   Next i

Next j


End Sub
 
Upvote 0
This Fluff code with the suggest
VBA Code:
Sub Price()

Dim pno As String
Dim LastRow As Long
Dim i As Integer
Dim LastRowinMainSheet As Long
Dim j As Integer

LastRowinMainSheet = Cells.Find(What:="*", _
                    After:=Range("E23"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row

LastRow = Sheets("Pricelist").UsedRange.SpecialCells(xlCellTypeLastCell).Row

For j = 24 To LastRowinMainSheet
   pno = Sheets("Emerson COMMERCIAL OFFER").Cells(j, 5).Value
  
   For i = 3 To LastRow
  
      If Sheets("Pricelist").Cells(i, 2).Value = pno Then
         Sheets("Emerson COMMERCIAL OFFER").Cells(j, 4).Value = Sheets("Pricelist").Cells(i, 3).Value
         Sheets("Emerson COMMERCIAL OFFER").Cells(j, 6).Value = Sheets("Pricelist").Cells(i, 4).Value
         Sheets("Emerson COMMERCIAL OFFER").Cells(j, 7).Value = Sheets("Pricelist").Cells(i, 5).Value
         Sheets("Emerson COMMERCIAL OFFER").Cells(j, 12).Value = Sheets("Pricelist").Cells(i, 14).Value
      End If
  
   Next i

Next j


End Sub
Hi, Thanks for the suggestion. I have tried the above method but a new error "Subscript out of range" is popping up.
 
Upvote 0
One more thing I guess
Try to change to
VBA Code:
Dim pno As Variant
 
Upvote 0
How about
VBA Code:
Sub Price()

Dim pno As String
Dim LastRow As Long
Dim i As Integer
Dim LastRowinMainSheet As Long
Dim j As Integer

LastRowinMainSheet = Worksheets(2).Cells.Find(What:="*", _
                    After:=Range("E23"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row

LastRow = Worksheets(3).UsedRange.SpecialCells(xlCellTypeLastCell).Row

For j = 24 To LastRowinMainSheet
   pno = Worksheets(2).Cells(j, 5).Value
   
   For i = 3 To LastRow
   
      If Worksheets(3).Cells(i, 2).Value = pno Then
         Worksheets(2).Cells(j, 4).Value = Worksheets(3).Cells(i, 3).Value
         Worksheets(2).Cells(j, 6).Value = Worksheets(3).Cells(i, 4).Value
         Worksheets(2).Cells(j, 7).Value = Worksheets(3).Cells(i, 5).Value
         Worksheets(2).Cells(j, 12).Value = Worksheets(3).Cells(i, 14).Value
      End If
   
   Next i

Next j


End Sub
 
Upvote 0
How about
VBA Code:
Sub Price()

Dim pno As String
Dim LastRow As Long
Dim i As Integer
Dim LastRowinMainSheet As Long
Dim j As Integer

LastRowinMainSheet = Worksheets(2).Cells.Find(What:="*", _
                    After:=Range("E23"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row

LastRow = Worksheets(3).UsedRange.SpecialCells(xlCellTypeLastCell).Row

For j = 24 To LastRowinMainSheet
   pno = Worksheets(2).Cells(j, 5).Value
  
   For i = 3 To LastRow
  
      If Worksheets(3).Cells(i, 2).Value = pno Then
         Worksheets(2).Cells(j, 4).Value = Worksheets(3).Cells(i, 3).Value
         Worksheets(2).Cells(j, 6).Value = Worksheets(3).Cells(i, 4).Value
         Worksheets(2).Cells(j, 7).Value = Worksheets(3).Cells(i, 5).Value
         Worksheets(2).Cells(j, 12).Value = Worksheets(3).Cells(i, 14).Value
      End If
  
   Next i

Next j


End Sub
Hi, I have tried this also but the code still doesn't work. There is no result when the code is executed.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,210
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top