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:

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).Range("E:E").Find(What:="*", _
                    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
 
Solution

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

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).Range("E:E").Find(What:="*", _
                    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, Thank you for the above code. It finally worked :). But, I wanted to make a few changes. I have copied the worksheet 3 items into another new workbook. Now, I want the code to execute the same but without opening the new workbook. To do this, I have modified the code but there is a "Subscript: Out of range" error popping up during the For loop for i. Also, my code actually opens the new workbook but I don't want the code to be executed without opening the workbook. Please can you help.

VBA Code:
Sub Price()

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


LastRowinMainSheet = Worksheets(2).Range("E:E").Find(What:="*", _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
Set f = Workbooks.Open("\\emrsn.org\VC-Drive_N\AEDU1_INSIDE_SALES\SPARES\Pricelist.xlsx", True, True)
LastRow = f.Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row

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

Next j

f.Close False
Set f = Nothing

End Sub
 
Last edited by a moderator:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,974
Office Version
  1. 365
Platform
  1. Windows
You need to open the other workbook in order to copy the values.
 

Tanyaann1995

Board Regular
Joined
Mar 24, 2021
Messages
57
Office Version
  1. 2016
Platform
  1. Windows
You need to open the other workbook in order to copy the values.
Hi, even if the workbook is opening, the above code is not working as I mentioned. Please advise what the problem is.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,974
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Is the code located in the workbook you are copying the values to?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,974
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

In that case try
VBA Code:
For j = 24 To LastRowinMainSheet
   pno = Worksheets(2).Cells(j, 5).Value
  
   For i = 3 To LastRow
      With ThisWorkbook.Worksheets(2)
         If f.Worksheets(1).Cells(i, 2).Value = pno Then
            .Cells(j, 4).Value = f.Worksheets(3).Cells(i, 3).Value
            .Cells(j, 6).Value = f.Worksheets(3).Cells(i, 4).Value
            .Cells(j, 7).Value = f.Worksheets(3).Cells(i, 5).Value
           .Cells(j, 12).Value = f.Worksheets(3).Cells(i, 14).Value
         End If
      End With
  
   Next i

Next j
 

Tanyaann1995

Board Regular
Joined
Mar 24, 2021
Messages
57
Office Version
  1. 2016
Platform
  1. Windows
Hi, Thank you for the above code. It finally worked :). But, I wanted to make a few changes. I have copied the worksheet 3 items into another new workbook. Now, I want the code to execute the same but without opening the new workbook. To do this, I have modified the code but there is a "Subscript: Out of range" error popping up during the For loop for i. Also, my code actually opens the new workbook but I don't want the code to be executed without opening the workbook. Please can you help.

VBA Code:
Sub Price()

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


LastRowinMainSheet = Worksheets(2).Range("E:E").Find(What:="*", _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
Set f = Workbooks.Open("\\emrsn.org\VC-Drive_N\AEDU1_INSIDE_SALES\SPARES\Pricelist.xlsx", True, True)
LastRow = f.Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row

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

Next j

f.Close False
Set f = Nothing

End Sub
Hi,

Thanks for the above code. I have tried this but the error " Runtime Error 9: Subscript Out of Range" still keeps popping up once the i Loop starts. Please help.
 

Tanyaann1995

Board Regular
Joined
Mar 24, 2021
Messages
57
Office Version
  1. 2016
Platform
  1. Windows
In that case try
VBA Code:
For j = 24 To LastRowinMainSheet
   pno = Worksheets(2).Cells(j, 5).Value
 
   For i = 3 To LastRow
      With ThisWorkbook.Worksheets(2)
         If f.Worksheets(1).Cells(i, 2).Value = pno Then
            .Cells(j, 4).Value = f.Worksheets(3).Cells(i, 3).Value
            .Cells(j, 6).Value = f.Worksheets(3).Cells(i, 4).Value
            .Cells(j, 7).Value = f.Worksheets(3).Cells(i, 5).Value
           .Cells(j, 12).Value = f.Worksheets(3).Cells(i, 14).Value
         End If
      End With
 
   Next i

Next j
Sorry.. please ignore the above comment. I have tried the above code but the same error "Runtime Error 9: Subscript Out of Range" keeps popping up after the i Loop. Please help.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,974
Office Version
  1. 365
Platform
  1. Windows
What line is highlighted when you click debug?
 

Forum statistics

Threads
1,144,342
Messages
5,723,824
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