VBA: Copy and paste multiple ranges within a row using Cells property

[blonde]

Hello,

I have a search functionality in an Excel workbook which searches according to a cell value from worksheet, "Search students", searches within worksheet, "2017-18 student list", then copies and pastes the find results in a third worksheet, "Search Results".

My problem concerns the copying. I'm trying to copy multiple ranges within a row, rather than just one range or the entire row. My code below successfully copies results from one range, columns 1-38.

.Range(.Cells(i, 1), .Cells(i, 38)).Copy

However, this includes some columns I need to exclude. Instead, I want to copy columns 1-7, 10-17, 19-24, 29-30, 37-38. (Ranges "A:G, J:Q, S:X, AC:AD, AK:AL")

This is my code:

Public Sub Faculty_only()

    Dim Findfaculty As String
    Dim ws As Worksheet
      
    
Findfaculty = Sheets("Search Students").Range("K12").Value
    
Set ws = ThisWorkbook.Sheets("2017-18 student list")
Finalrow = Sheets("2017-18 student list").Range("A902").End(xlUp).Row
 
With ws
    
    For i = 7 To Finalrow
    
        If .Cells(i, 1).Value = Findfaculty Then
        
        .Range(.Cells(i, 1), .Cells(i, 38)).Copy
        Sheets("Search Results").Range("A901").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        
        End If
    Next i
    
    Sheets("Search Results").Select
    Range("A1").Select
    End With


End Sub

I have tried using union but I can't get it to work while using the cells property method. I get a run-time error '13' type mismatch error. (Possibly because the cells property needs r to be an integer not a range?) Here is my code attempt using union:

Public Sub Faculty_only()

    Dim Findfaculty As String
    Dim ws As Worksheet
    
    Dim range1 As Range
    Dim range2 As Range
    Dim range3 As Range
    Dim range4 As Range
    Dim range5 As Range
    Dim r As Range
        
    
Findfaculty = Sheets("Search Students").Range("K12").Value

Set range1 = Sheets("2017-18 student list").Range("A:G")
Set range2 = Sheets("2017-18 student list").Range("J:Q")
Set range3 = Sheets("2017-18 student list").Range("S:X")
set range4 = Sheets("2017-18 student list").Range("AC:AD")
set range5 = Sheets("2017-18 student list").Range("AK:AL")
Set r = Union(range1, range2, range3, range4, range5)
    
Set ws = ThisWorkbook.Sheets("2017-18 student list")
Finalrow = Sheets("2017-18 student list").Range("A902").End(xlUp).Row

 
With ws
    
    For i = 7 To Finalrow
    
        If .Cells(i, 1).Value = Findfaculty Then
        
        .Range(.Cells(i, r)).Copy
        Sheets("Search Results").Range("A901").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        
        End If
    Next i
    
    Sheets("Search Results").Select
    Range("A1").Select
    End With


End Sub

Any help to get this working would be greatly appreciated!

 

[Fluff]

Hi & welcome to MrExcel
Untested but try

Public Sub Faculty_only()

    Dim Findfaculty As String
    Dim ws As Worksheet

Findfaculty = Sheets("Search Students").Range("K12").Value

Set ws = ThisWorkbook.Sheets("2017-18 student list")
Finalrow = Sheets("2017-18 student list").Range("A902").End(xlUp).Row

With ws

    For i = 7 To Finalrow
        If .Cells(i, 1).Value = Findfaculty Then
        Intersect(Range("A:G, J:Q, S:X, AC:AD, AK:AL"), Rows(i)).Copy
        Sheets("Search Results").Range("A901").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        
        End If
    Next i

    Sheets("Search Results").Select
    Range("A1").Select
    End With


End Sub

 

[blonde]

Hi Fluff,

Many thanks for the reply. Although there is no syntax error, unfortunately, the intersect code is not pasting back any results! Do you have any further suggestions please?

Thank you!

 

[Fluff]

Try stepping through the code using F8 & see what happens. Does the code ever get to the intersect line?

 

[blonde]

I've stepped through it as you suggested, thanks. It is copying and pasting from the "Search Students" sheet instead of sheet ws ["2017-18 student list"].
(So it is copying and pasting from blank rows.). When I have stepped through it while displaying ws as the active sheet, it works.

I think I therefore need to set the active focus to sheet ws on the intersect code. I have tried this:

Intersect(ws.Range("A:G, J:Q, S:X, AC:AD, AK:AL"), Rows(i)).Copy

however, I get the following message:

Run-time error '1004': Method 'Intersect of object'_Global' failed

I'd be grateful for further advice please.

 

[Fluff]

You've almost got it, you just need to qualify the rows as well, try

Intersect(.Range("A:G, J:Q, S:X, AC:AD, AK:AL"), .Rows(i)).Copy

As this is in a with statement, you don't need the ws, just a .

 

[blonde]

That's it! Cracked it! Thank you VERY much for your help on this.

 

[Fluff]

Glad to help & thanks for the feedback