---

MS Excel 2003: Test each value in column A and copy matching values into new sheets

This Excel tutorial explains how to write a macro to test each value in a column and copy the matching values into new sheets in Excel 2003 and older versions (with screenshots and step-by-step instructions).

Question: In Microsoft Excel 2003/XP/2000/97, how can I write an Excel macro that needs to compare data in column A and copy matching values into new sheets.

So if there were 100 rows in the sheet and the data in column A for the first 50 were equal, but A51 contained a different value and you wanted to copy the data from A2 through A50 onto a new sheet.

Then the macro would continue comparing the values in column A starting from Cell A51 until a different value was encountered. It would then copy the data into a new sheet, and so on...until all values had been evaluated in column A.

Answer: You should be able to create a macro that tests each value in column A and checks for differences.

Let's look at an example.

Download Excel spreadsheet (as demonstrated below)

In our spreadsheet, we've created a button on the Data sheet called "Copy Data". When the user clicks on this button, a macro called CopyData will run. This macro will analyze each value in column A to search for a different value.

When a different value is found in column A on the Data sheet, the macro will then copy the values in columns A through D up to the different value, and paste to a new sheet.

So in this example, it copies all rows until it reaches the Microsoft value in cell A8 (on the Data sheet) and pastes these values to a new sheet called "Tech on the Net".

The macro then goes back to column A on the Data sheet and continues analyzing the value starting from cell A8.

It then creates another sheet called "Microsoft" and copies the Microsoft data into this new sheet.

When the macro has completed, the above message box will appear.

You can press Alt+F11 to view the VBA code.

Macro Code

The macro code looks like this:

Sub CopyData()

   Dim LMainSheet As String
   Dim LRow As Integer
   Dim LContinue As Boolean
   Dim LColAMaster As String
   Dim LColATest As String

   'Retrieve name of sheet that contains the data
   LMainSheet = ActiveSheet.Name

   'Initialize variables
   LContinue = True
   LRow = 2

   'Start comparing with cell A2
   LColAMaster = "A2"

   'Loop through all column A values until a blank cell is found
   While LContinue = True

      LRow = LRow + 1
      LColATest = "A" & CStr(LRow)

      'Found a blank cell, do not continue
      If Len(Range(LColATest).Value) = 0 Then
         LContinue = False
      End If

      'Found occurrence that did not match, copy data to new sheet
      If Range(LColAMaster).Value <> Range(LColATest).Value Then

         'Copy headings
         Range("A1:D1").Select
         Selection.Copy

         'Add new sheet and paste headings into new sheet
         Sheets.Add.Name = Range(LColAMaster).Value
         ActiveSheet.Paste
         Range("A1").Select

         'Copy data from columns A - D
         Sheets(LMainSheet).Select
         Range(LColAMaster & ":D" & CStr(LRow - 1)).Select
         Selection.Copy

         'Paste results
         Sheets(Range(LColAMaster).Value).Select
         Range("A2").Select
         ActiveSheet.Paste
         Range("A1").Select

         'Go back to Main sheet and continue where left off
         Sheets(LMainSheet).Select
         LColAMaster = "A" & CStr(LRow)

      End If
   Wend

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

   MsgBox "Copy has completed."

End Sub