CODEWITHSUNDEEP
excelvba
Filipe Aleixo
Filipe Aleixo

Reputation: 4242

Unable to copy entire row from one sheet to the other with VBA

I'm trying to make a search tool with VBA to find all the ocurrences in all sheets of a given SearchString input by the user. It is supposed to paste the whole rows where this SearchString was found in the different sheets in their corresponding column on a sheet called "Search". This is illustrated by the figure below:

enter image description here

So the rows found in the sheet Free REQs should be started being pasted in cell A11, and pasted in consecutive rows until no more correspondences are found in the sheet Free REQs, then the rows found in the sheet Temporary should be started being pasted in cell N11, and so on for all the sheets (the tables in the different sheets have the same number of columns as the corresponding tables in the Search sheet). For this, I have the following code (TableColumn is the column where each table in the Search sheet starts, e.g. for Free REQs it will be "B"):

Private Sub OKButton_Click()
    Dim TableColumn As String
    Dim SearchString As String
    Dim SheetNames() As Variant
    Dim Loc As Range
    Dim CurrentRow

    SearchString = TextBox.Value

    'Sheets where we want to find stuff
    SheetNames = Array("Free REQs", "Temporary", "FTE", "Hierarchy", "all REQs", "EMEA TEAM")

    'Code to find all occurrences in all sheets MAKE SEPARATE SUB FOR THIS (from: http://stackoverflow.com/questions/19504858/find-all-matches-in-workbook-using-excel-vba)
    'Start filling the results table in row 11
    CurrentRow = 11

    For Each Sh In SheetNames
        TableColumn = GetTableBeginColumn(Sh)
        With Sheets(Sh)
            'Find in all sheets where SearchString ocurrs
            Set Loc = .UsedRange.Cells.Find(What:=SearchString)
            If Not Loc Is Nothing Then
                Do Until Loc Is Nothing
                    'Copy the data from the original source
                    .Rows(Loc.Row).EntireRow.Copy
                    'Paste it into the Search sheet
                    ActiveSheet.Paste Destination:=Sheets("Search").Range(TableColumn & CurrentRow)
                    'Find the next occurrence of SearchString
                    Set Loc = .UsedRange.FindNext(Loc)
                    'Fill the next empty row next
                    CurrentRow = CurrentRow + 1
                Loop
            End If
        End With
        CurrentRow = 11
        Set Loc = Nothing
    Next

End Sub

Although, for this line:

ActiveSheet.Paste Destination:=Sheets("Search").Range(TableColumn & CurrentRow)

I'm getting the error:

enter image description here

Even though TableColumn & CurrentRow corresponds to the string that defines a single cell. What am I missing here?

Upvotes: 1

Views: 617

Answers (1)

user3598756
user3598756

Reputation: 29421

try this little refactoring

Option Explicit

Private Sub OKButton_Click()
    Dim TableColumn As String
    Dim SearchString As String
    Dim SheetNames() As Variant
    Dim Loc As Range
    Dim CurrentRow
    Dim sh As Variant
    Dim firstAddress As String

    SearchString = TextBox.Value

    'Sheets where we want to find stuff
    SheetNames = Array("Free REQs", "Temporary", "FTE", "Hierarchy", "all REQs", "EMEA TEAM")

    'Code to find all occurrences in all sheets MAKE SEPARATE SUB FOR THIS (from: http://stackoverflow.com/questions/19504858/find-all-matches-in-workbook-using-excel-vba)
    'Start filling the results table in row 11
    CurrentRow = 11

    For Each sh In SheetNames
        TableColumn = GetTableBeginColumn(sh)
        With Sheets(sh)
            'Find in all sheets where SearchString ocurrs
            Set Loc = .UsedRange.Cells.Find(What:=SearchString)
            If Not Loc Is Nothing Then
                firstAddress = Loc.Address '<--| store first found cell address
                Do
                    'Copy the data from the original source
                    Intersect(.Rows(Loc.Row).EntireRow, .UsedRange).Copy Destination:=Sheets("Search").Range(TableColumn & CurrentRow) '<--| copy only a "finite" amount of columns
                    'Find the next occurrence of SearchString
                    Set Loc = .UsedRange.FindNext(Loc)
                    'Fill the next empty row next
                    CurrentRow = CurrentRow + 1
                Loop While Loc.Address <> firstAddress '<--| loop until 'Find()' wraps back to first found cell
            End If
        End With
        CurrentRow = 11
        Set Loc = Nothing
    Next

End Sub

Upvotes: 1

Related Questions