Search code examples
vbaexcelloopsfindcopy-paste

VBA Find Text in Row 1. Copy & paste below rows if greater than zero


i have a code which searches for a text string in row 1. The seraching has no issues .

Problem

When the text is found i need the macro to search the column for values greater that zero and if found to copy the whole row and paste into sheet 2. So i have had no success.

Please see code below:

Private Sub btnUpdateEntry_Click()

    Dim StringToFind As String
Dim i As Range
    StringToFind = Application.InputBox("Enter string to find", "Find string")

    Worksheets("Skills Matrix").Activate
    ActiveSheet.Rows(1).Select

        Set cell = Selection.Find(What:=StringToFind, After:=ActiveCell, _
        LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)


    For Each i In cell
        If i.Value > 0 Then
            i.Select
            ActiveCell.Range("1:1").EntireRow.Select
            Selection.Copy
            Sheets("Sheet2").Range("A65000").End(xlUp).Offset(1, 0).PasteSpecial
        End If
    Next i

    If cell Is Nothing Then
        Worksheets("Data").Activate
        MsgBox "String not found"
    End If

End Sub

Thank you.


Solution

  • Try this, although I doubt that you need to search the entire column? Your loop was only searching one cell. This code would need amending if the search string could be found more than once in the first row.

    Private Sub btnUpdateEntry_Click()
    
    Dim StringToFind As String
    Dim i As Range
    Dim cell As Range
    
    StringToFind = Application.InputBox("Enter string to find", "Find string")
    
    With Worksheets("Skills Matrix")
        Set cell = .Rows(1).Find(What:=StringToFind, LookAt:=xlWhole, _
                                 MatchCase:=False, SearchFormat:=False)
    
        If Not cell Is Nothing Then
            For Each i In .Range(cell.Offset(1), .Cells(.Rows.Count, cell.Column).End(xlUp))
                If IsNumeric(i.Value) Then
                    If i.Value > 0 Then
                        i.EntireRow.Copy
                        Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
                    End If
                End If
            Next i
        Else
            Worksheets("Data").Activate
            MsgBox "String not found"
        End If
    End With
    
    End Sub