---

MS Excel 2003: Test each value in column A until a different value is found

This Excel tutorial explains how to write a macro to test each value in a column until a different value is found in Excel 2003 and older versions (with screenshots and step-by-step instructions).

Question: In Microsoft Excel 2003/XP/2000/97, how would you suggest writing an Excel VBA Loop statement that needs to compare data in Cell A2 to A3 and so on until it doesn't find a match? 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. How would you suggest I attempt that?

Answer: You should be able to create a macro that tests each value in column A against the value in cell A2, and finds the first value that is different.

Let's look at an example.

Download Excel spreadsheet (as demonstrated below)

In our spreadsheet, we've created a button on Sheet1 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 the first value that is different from cell A2.

The macro will then copy the values in columns A through C on Sheet1 to Sheet2 based on its analysis. So in this example, it copies all rows until it reaches the Microsoft value in cell A8 (on Sheet1).

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 LRow As Integer
   Dim LColARange As String
   Dim LContinue As Boolean

   'Select Sheet1
   Sheets("Sheet1").Select
   Range("A2").Select

   'Initialize variables
   LContinue = True
   LRow = 2

   'Loop through all column A values until a blank cell is found or value does not
   ' match cell A2's value
   While LContinue = True

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

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

      'Found first occurrence that did not match cell A2's value, do not continue
      If Range("A2").Value <> Range(LColARange).Value Then
         LContinue = False
      End If

   Wend

   'Copy data from columns A - C
   Range("A2:C" & CStr(LRow - 1)).Select
   Selection.Copy

   'Paste results to cell A1 in Sheet2
   Sheets("Sheet2").Select
   Range("A1").Select
   ActiveSheet.Paste

   MsgBox "Copy has completed."

End Sub