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


Question:  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

Spreadsheet News


Book Shop


Visit our busy book shop, were you can find latest books for beginners as well as advanced excel users.



Software Library




Spreadsheet123

Spreadsheet 123 Spreadsheet Software Development

Home | About Us | Our Services | Software | Spreadsheets Library | Excel Tutorials | Useful Links | Site Map | Contact Us
Home
About Us
About Spreadsheet
Book Shop
Excel Tutorials
1
Spreadsheets Library
3
4
5
6
Our Services
8
Site Map
Software
11
12
13
14
15
16
17