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

[blonde]

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.)

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:

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 ...

 

[jmacleary]

Try changing your line to:

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

 

[blonde]

Thank you for this. Unfortunately, I am now getting a run time error '91' on the next line down. The error message is: 'Object variable or with block variable not set'. This is occuring on:

pop_fin.Offset(, -4).Resize(, 4).Copy

 

[jmacleary]

Are you always expecting the find to make a hit? I suspect the find is failing to find anything, in which case the pop_fin range won't be set. You could wrap a test around the copy code to skip it as follows:

    If pop_fin Is Nothing Then
    Else
        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

 

[blonde]

Thank you very much, that has fixed the run time error. Unfortunately, the find is still not working. I was wondering if there should be a second find to look for the acad_year value in ws2? The acad_year values are in column range "H" in ws2 and I've realised that the code line does not make reference to it. It just deals with id. Also, the column headers are on row 7 in ws2 with a couple of blank rows above (I'm not sure if that makes any difference.)

Please could you advise if this is correct and if so how the code line should incorporate it?:

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

 

[mumps]

Can you post a screen shot of both sheets? Section B at this link has instructions on how to post a screen shot: https://www.mrexcel.com/forum/board-announcements/127080-guidelines-forum-use.html Alternately, you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data.

 

[Dryver14]

try this in the with statement, long winded but I think it is doing what you want

With ws
    For i = 7 To Finalrow
    If .Cells(i, 9).Value = acad_year Then
    'Set pop_fin = ws2.Range("E7:E1000").Find(ws.Range("F" & i).Value, , , xlWhole, , , False, , False)
        ws2.Cells("E7:E1000").Select
            For Each cell In Selection
                If cell.Value = ws.Cells(i, 6).Value Then
            
            
    'If Not pop_fin Is Nothing 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
            Next cell
    End If
    End If
    End If
    
    Next i
   
End With

 

[blonde]

Hi,

Thank you for this. I have tried your amendment:

ws2.Cells("E7:E1000").Select

Unfortunately it is generating run time error '5' - 'invalid procedure, call or argument' which I can't resolve. I think this does seem to be what I need it to do if I can get it working. To clarify, I need to match records on both sheets (ws and ws2) according to two fields on both sheets, ID and acad_year (acad period). Where a student has more than one record in ws2, the code needs to find the correct record according to the value in acad_year.

I have tried to add a sample copy of my two sheets into the thread but it seems you can only add tables into new threads, not existing ones?

 

[Dryver14]

try changing it to ws2.Range("E7:E1000").select

 

[blonde]

Thank you, I've tried that but got a different run time error '1004 - select method of rnage class failed'. Here is my code as it stands now. (I had to move the two end if's to before the 'next cell' to clear a different run time error, but I don't think that would have affected this.):

With ws
    
    For i = 7 To Finalrow
    If .Cells(i, 9).Value = acad_year Then
    'Set pop_fin = ws2.Range("E7:E1000").Find(ws.Range("F" & i).Value, , , xlWhole, , , False, , False)

    ws2.Range("E7:E1000").Select
        For Each Cell In Selection
            If Cell.Value = ws.Cells(i, 6).Value Then

    'If Not pop_fin Is Nothing 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
   
End With