VBA: Issue with find, copying & pasting across two worksheets

blonde

New Member
Joined
Feb 12, 2018
Messages
28
Hello,

I have a problem with some find, copy and paste coding. On a userform, there is a listbox for the academic year (acad_year) and a textbox for the unique record id (id) which supplies the two variables for this part of the coding. Both of these are working correctly and storing the correct values. The coding looks for these two values in a list in sheet ws, then finds the corresponding id and acad_year in the list in sheet ws2. It then copies and pastes ranges from the relevant row (row i) from ws2 into ws (row i).

The issue is that the coding is not finding the correct acad_year. Where an id has two records in ws2, a 17/18 record and a 18/19 record, it is not finding, copying and pasting the 18/19 record. It is pasting the first record it finds for id in ws2 which is the 17/18 one. (I checked this by switching the records round.)

I think the error may be somewhere on this line, but I don't know how to rectify it. (Range E is the column containing the id in ws2.)

Code:
Set pop_fin = ws2.Range("E7:E1000").Find(ws.Range("F" & i).Value, , , xlWhole, , , False, , False)

I would be very grateful for any help on this. The relevant parts of my code are below:

Code:
Public Sub Pop_Stu_list()

Dim ws As Worksheet
Dim ws2 As Worksheet
Dim pop_fin As Range
Dim lItem As Long
Dim acad_year As String
Dim lItem2 As Long
Dim faculty As String
Dim id As String

Set ws = ThisWorkbook.Sheets("student list")
Set ws2 = ThisWorkbook.Sheets("QLS Download")

For lItem = 0 To UserForm3.ListBox1.ListCount - 1
        If UserForm3.ListBox1.Selected(lItem) Then
            acad_year = UserForm3.ListBox1.List(lItem)
        End If
    Next lItem
    
For lItem2 = 0 To UserForm3.ListBox2.ListCount - 1
        If UserForm3.ListBox2.Selected(lItem2) Then
            faculty = UserForm3.ListBox2.List(lItem2)
        End If
    Next lItem2
    
id = UserForm3.TextBox1.Value
    
Finalrow = Sheets("student list").Range("A902").End(xlUp).Row
Finalrow2 = Sheets("QLS Download").Range("E902").End(xlUp).Row

Application.ScreenUpdating = False

If id <> "" Then

    With ws    
    For i = 7 To Finalrow
    
    If .Cells(i, 9).Value = acad_year And _
       .Cells(i, 6).Value = id Then
    
    Set pop_fin = ws2.Range("E7:E1000").Find(ws.Range("F" & i).Value, , , xlWhole, , , False, , False)
    
    pop_fin.Offset(, -4).Resize(, 4).Copy
    ws.Range("B" & i).PasteSpecial xlPasteValues
    pop_fin.Offset(, 5).Resize(, 1).Copy
    ws.Range("H" & i).PasteSpecial xlPasteValues
    pop_fin.Offset(, 7).Resize(, 3).Copy
    ws.Range("J" & i).PasteSpecial xlPasteValues
            
    End If       
    Next i   
End With

'further coding not included ...
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

blonde

New Member
Joined
Feb 12, 2018
Messages
28
I set dim Cell as Range but got the same run time error '1004' as before. I tried changing the code line back to:
Code:
ws2.Cell("E7:E1000").Select
and now have the message: 'Compile error: Method or data member not found' on the .Cell part of this line.
 

Dryver14

Well-known Member
Joined
Mar 22, 2010
Messages
2,396
We seem to be doing 2 things at once. Lose the with, end with

try this

Code:
For i = 7 To Finalrow
    If Cells(i, 9).Value = acad_year Then
    
    ws2.Range("E7:E1000").Select
        For Each Cell In Selection
            If Cell.Value = ws.Cells(i, 6).Value Then
                If Cell.Offset(, 6).Value = acad_year Then
                    Cell.Offset(, -4).Resize(, 4).Copy
                    ws.Range("B" & i).PasteSpecial xlPasteValues
                    Cell.Offset(, 5).Resize(, 1).Copy
                    ws.Range("H" & i).PasteSpecial xlPasteValues
                    Cell.Offset(, 7).Resize(, 3).Copy
                    ws.Range("J" & i).PasteSpecial xlPasteValues
                End If
            End If
        
        Next Cell
        
    End If
        
    Next i
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,306
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Thank you, I've tried that but got a different run time error '1004 - select method of rnage class failed'.

Personally I would just remove the Select as you can only Select on the active sheet i.e.

Code:
ws2.Range("E7:E1000").Select
        For Each Cell In Selection
becomes
Code:
For Each Cell In ws2.Range("E7:E1000")

but then I would probably loop the find i.e. replace this in the original code
Code:
    Set pop_fin = ws2.Range("E7:E1000").Find(ws.Range("F" & i).Value, , , xlWhole, , , False, , False)
    
    pop_fin.Offset(, -4).Resize(, 4).Copy
    ws.Range("B" & i).PasteSpecial xlPasteValues
    pop_fin.Offset(, 5).Resize(, 1).Copy
    ws.Range("H" & i).PasteSpecial xlPasteValues
    pop_fin.Offset(, 7).Resize(, 3).Copy
    ws.Range("J" & i).PasteSpecial xlPasteValues
with the code below(untested)

Rich (BB code):
Dim pop_fin As Range, fAddr As String
    
    'Rest of code

    With ws2.Range("E7:E1000")

        Set pop_fin = .Find(ws.Range("F" & i).Value, , , xlWhole, , , False, , False)

        If Not pop_fin Is Nothing Then
            fAddr = pop_fin.Address
            Do
                If Not pop_fin Is Nothing Then
                    pop_fin.Offset(, -4).Resize(, 4).Copy
                    ws.Range("B" & i).PasteSpecial xlPasteValues
                    pop_fin.Offset(, 5).Resize(, 1).Copy
                    ws.Range("H" & i).PasteSpecial xlPasteValues
                    pop_fin.Offset(, 7).Resize(, 3).Copy
                    ws.Range("J" & i).PasteSpecial xlPasteValues
                End If

                Set pop_fin = .FindNext(pop_fin)

                If pop_fin Is Nothing Then
                    Exit Do
                End If

                If pop_fin.Address = fAddr Then
                    Exit Do
                End If

            Loop
        End If
    End With

Please note that you will have to change E7 to E6 if E7 isn't a header or change the After criteria to Range("E1000") in the Find.
 
Last edited:

Dryver14

Well-known Member
Joined
Mar 22, 2010
Messages
2,396

ADVERTISEMENT

Thanks for jumping in Mark,

I was starting to confuse myself
 

blonde

New Member
Joined
Feb 12, 2018
Messages
28
I have now got it working! I used your line that replaced the select statement, but I will also experiment using the loop you provided. Thank you both very much for your all your time and help on this, I really appreciate it.

There is just one new bug that seems to have appeared out of this. I'm sorry to be a pain. The values pasted into ws do not show up until you refresh the screen (eg. moving from one sheet and back again, or scrolling up). I haven't encountered this before. Do you know how I can stop this so that the data populates immediately in front of you?
 

blonde

New Member
Joined
Feb 12, 2018
Messages
28
I now seem to have resolved the bug with the screen data updating, not sure quite how. Thanks again.
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,306
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
I now seem to have resolved the bug with the screen data updating, not sure quite how. Thanks again.
Your welcome, the Findnext loop should be faster if you have large sets of data (currently yours isn't large) as long as I haven't made any typos.
 
Last edited:

Forum statistics

Threads
1,148,006
Messages
5,744,311
Members
423,859
Latest member
joannetung

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