An Excel VBA macro that copies specific rows to another sheet

A friend of mine had heard a lot of nice things about Excel. And then at some point, he had to use Excel 97 in his job to manage a table (a sheet) of entries. He immediately found Excel useful. But he visited me in order to help him make the most of it. As he explained to me, he had a sheet of entries. Each entry (row) occupied columns A to J. What he wanted was to provide a string to Excel and Excel would search for this string in his entries. If the string matched any cell exactly, then the corresponding row would be copied to another sheet. His original entries would remain intact.

Let me give you an example of what my friend wanted. Suppose he had the following Sheet1:

If my friend would give the string “test1”, then rows 1 and 3 should be copied to Sheet2. If instead he would give the string “one”, then rows 2 and 4 should be copied to Sheet2. If instead he would give the string “test9”, then rows 1, 3 and 4 should be copied to Sheet2. If he would give the string “seven”, then rows 2, 3 and 4 should be copied to Sheet2. And so on.

When I told him that Excel does not have this capability built-in, he was surprised. Surprised in a bad way. He had heard a lot of nice things about Excel, but this was the only thing that he needed and without it he would not be able to get things done. He was puzzled that the Excel designers did not put such a feature in Excel. From his point of view, this funcionality, this feature, was what mattered most.

I told him not to worry. I would built it for him. I had Excel 97 installed on my PC. I offered him a chair next to me and I wrote the following Excel VBA macro. The macro is supposed to exist only in a workbook named MyImportantList.xls.

Option Explicit

Sub CopySpecificRows()

    Dim myInputValue As String
    Dim myFound As Boolean
    Dim myRowIndex As Long
    Dim mySheet2RowIndex As Long
    Dim myString As String
    Dim myHits As Long

    If ActiveWorkbook.Name <> "MyImportantList.xls" Then
      MsgBox "This action will not be executed. This action can only be executed in the Excel workbook MyImportantList.xls"
      End
    End If

    Sheets("Sheet2").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select

    Sheets("Sheet1").Select
    Range("A1").Select

    myString = ""
    myInputValue = ""
    myInputValue = InputBox("Enter string to search for." & vbCrLf & "Columns from A to J will be searched.")

    If myInputValue = "" Then
       MsgBox "You did not enter a search string. The search will not be performed."
       End
    End If

    myRowIndex = 0
    mySheet2RowIndex = 0
    myHits = 0

    Do
       myRowIndex = myRowIndex + 1
       If Range("A" & CStr(myRowIndex)).Text = "" Then
          Exit Do
       End If
       myFound = False

       If Range("A" & CStr(myRowIndex)).Text = myInputValue Then
          myFound = True
       End If
       If Range("B" & CStr(myRowIndex)).Text = myInputValue Then
          myFound = True
       End If
       If Range("C" & CStr(myRowIndex)).Text = myInputValue Then
          myFound = True
       End If
       If Range("D" & CStr(myRowIndex)).Text = myInputValue Then
          myFound = True
       End If
       If Range("E" & CStr(myRowIndex)).Text = myInputValue Then
          myFound = True
       End If
       If Range("F" & CStr(myRowIndex)).Text = myInputValue Then
          myFound = True
       End If
       If Range("G" & CStr(myRowIndex)).Text = myInputValue Then
          myFound = True
       End If
       If Range("H" & CStr(myRowIndex)).Text = myInputValue Then
          myFound = True
       End If
       If Range("I" & CStr(myRowIndex)).Text = myInputValue Then
          myFound = True
       End If
       If Range("J" & CStr(myRowIndex)).Text = myInputValue Then
          myFound = True
       End If

       If myFound = True Then
          myHits = myHits + 1
          myString = CStr(myRowIndex) & ":" & CStr(myRowIndex)
          Rows(myString).Select
          Selection.Copy

          Sheets("Sheet2").Select
          mySheet2RowIndex = mySheet2RowIndex + 1
          Range("A" & CStr(mySheet2RowIndex)).Select
          ActiveSheet.Paste

          Sheets("Sheet1").Select
       End If

    Loop

    If myHits = 0 Then
       MsgBox "No matching cells found." & vbCrLf & "Your search string was: " & CStr(myInputValue)       
       End
    End If

    Sheets("Sheet1").Select
    Application.CutCopyMode = False
    Range("A1").Select

    Sheets("Sheet2").Select
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select

End Sub

This macro can be run as many times as needed. Each time the macro is run, it clears Sheet2 of all its contents and then copies there the rows from Sheet1 that have at least one cell that matches the string given by the user. Because the macro clears the previous contents of Sheet2 without warning, you should be careful how you use it. This is why I included the test at the beginning of the macro, where I make sure that the Excel workbook is indeed the one that is supposed to use this macro.

The next day, I went in his office with this code and I created the Excel VBA macro in his MyImportantList.xls workbook. He happily used it for years, until he left that job for a better one.

Advertisements

About Dimitrios Kalemis

I am a systems engineer specializing in Microsoft products and technologies. I am also an author. Please visit my blog to see the blog posts I have written, the books I have written and the applications I have created. I definitely recommend my blog posts under the category "Management", all my books and all my applications. I believe that you will find them interesting and useful. I am in the process of writing more blog posts and books, so please visit my blog from time to time to see what I come up with next. I am also active on other sites; links to those you can find in the "About me" page of my blog.
This entry was posted in Development. Bookmark the permalink.