MS Excel: Test each value in column A until a different value is found in Excel 2003/XP/2000/97

Question: In 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 take a 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