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

Tanyaann1995

Board Regular
Joined
Mar 24, 2021
Messages
57
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

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,974
Office Version
  1. 365
Platform
  1. Windows
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
 

Tanyaann1995

Board Regular
Joined
Mar 24, 2021
Messages
57
Office Version
  1. 2016
Platform
  1. Windows
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.
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,096
Office Version
  1. 2013
Platform
  1. Windows
Hi
I suggest to use sheets name instead of sheets code name
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,096
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

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
 

Tanyaann1995

Board Regular
Joined
Mar 24, 2021
Messages
57
Office Version
  1. 2016
Platform
  1. Windows
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.
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,096
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

On which line the error appears?
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,096
Office Version
  1. 2013
Platform
  1. Windows
One more thing I guess
Try to change to
VBA Code:
Dim pno As Variant
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,974
Office Version
  1. 365
Platform
  1. Windows
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
 

Tanyaann1995

Board Regular
Joined
Mar 24, 2021
Messages
57
Office Version
  1. 2016
Platform
  1. Windows
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.
 

Forum statistics

Threads
1,144,342
Messages
5,723,821
Members
422,518
Latest member
quack_quack

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
Top