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:
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
 
Upvote 0
Solution

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
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:
Upvote 0
You need to open the other workbook in order to copy the values.
 
Upvote 0
Is the code located in the workbook you are copying the values to?
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
What line is highlighted when you click debug?
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,988
Members
448,538
Latest member
alex78

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