VBA copy paste copies only first matching record from range

[n3wb33]

Hello,

I have a problem in copy pasting records which match a user defined criteria. A user can define a criteria and hit 'run' button. Records which match criteria are copied from a different sheet (same workbook) and should be pasted into a table on the active sheet without spaces. There are 55 columns.

I have the following code, but for some reason it only brings out the first matching record only. Help!

'Module to search all Wards' records that match a Ward name specified in the drop-down menu

Sub findward()
Dim wardname As String
Dim finalrow As Integer
Dim i As Long

Sheets("Ward_rank_table").Range("B7:BC157").ClearContents
wardname = Sheets("Ward_rank_table").Range("B3").Value
finalrow = Sheets("Ward_rank_set").Range("B160").End(xlUp).Row

Sheets("Ward_rank_set").Select
For i = 2 To finalrow
If Cells(i, 2) = wardname Then
Range(Cells(i, 2), Cells(i, 55)).Copy
Sheets("Ward_rank_table").Select
Range("B7").End(xlUp).Offset(1, 0).Resize(1, 55).PasteSpecial xlPasteFormulasAndNumberFormats

End If


Next i

Range("B3").Select

 

[Gingertrees]

Welcome to the board!
Tip: if you type [ followed by the word CODE and another bracket ] , you can get the green code window below.

'code box!

do the same at the end with a /code tag to close it.

THAT SAID...
I'm not clear on some of your coding here. Are you looking for the last row in the Ward_Rank_Set sheet? You may be throwing off that calculaiton by the way you have it finding FinalRow.
Also, anytime you can get calculations out of the way ahead of time, do it. Establish a FinalRow for hte Ward Rank Table sheet, too.

Dim FinalRowSet as integer, FinalRowTable as integer
With Sheets("Ward_Rank_Set")
    FinalRowSet = .Cells(.Rows.Count, 2).End(xlUp).Row '//bottom row in column B on the _Set sheet
End With    
With Sheets("Ward_Rank_Table")
    FinalRowTable = .Cells(.Rows.Count, 2).End(xlUp).Row '//bottom row in column B on the _Table sheet
End With  

Sheets("Ward_rank_set").Select
For i = 2 To finalrow
    If Cells(i, 2) = wardname Then
        Range(Cells(i, 2), Cells(i, 55)).Copy
        With Sheets("Ward_rank_table")
             .Cells(FinalRowTable,2).Offset(1, 0).Resize(1, 55).PasteSpecial xlPasteFormulasAndNumberFormats
        End With
       '///////
    End If

Next i

 

[JackDanIce]

Alternative solution that filters for the value in B3 in sheet Ward_Rank_Set and copies the results (formulas and number formats) to sheet Ward_Rank_Table:

Sub findward_v1()

    Dim wTbl    As Worksheet
    Dim wSet    As Worksheet
    
    Dim x       As Long
    Dim str     As String
    
    Set wTbl = Sheets("Ward_rank_table")
    Set wSet = Sheets("Ward_rank_set")
    
    Application.ScreenUpdating = False
    
    With wTbl
        str = .Range("B3").Value
        x = .Cells(.Rows.Count, 2).End(xlUp).Row
        .Range("B7:B" & x).ClearContents
    End With
        
    With wSet
        If .AutoFilterMode Then .AutoFilterMode = False
        
        x = .Cells(.Rows.Count, 2).End(xlUp).Row
        
        With .Range("B2").Resize(x - 1, 55)
            .AutoFilter field:=1, Criteria1:=str
            .Offset(1).Resize(x - 2).SpecialCells(xlCellTypeVisible).Copy
        End With
        
        .AutoFilterMode = False
    End With
    
    With wTbl
        x = Application.Max(8, .Cells(.Rows.Count, 2).End(xlUp).Row + 1)
        .Cells(x, 2).PasteSpecial xlPasteFormulasAndNumberFormats
        If ActiveSheet.Name <> .Name Then .Select
    End With
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
        .Goto Range("B3"), True
    End With
    
    Set wTbl = Nothing
    Set wSet = Nothing
    
End Sub

 

[n3wb33]

Hi @jackdannice! Thank you so much for the code! It works except it does not clean the results of the previous run. For example if the list of wards in new search is shorter than the previous, previous matches will remain at the bottom of the new list. Any ideas why? I thought .clearcontents was supposed to clear it before every run...

 

[n3wb33]

thanks for the tip @gingertrees! i am very new to vba and trying to teach myself how to code. so far not so good. no, i am not attached to lastrow in any way. the idea of including it was to let the code know when to stop searching for matches.

 

[n3wb33]

oh, i just found why. the range before .clearcontents needs to include all columns. it is working now, thanks again! Code:
.Range("B7:B" & x).ClearContents

.Range("B7:BC" & x).ClearContents</pre>

 

[JackDanIce]

Glad it works and you resolved the non-clearning issue, typo mistake on my suggestion