How do I iterate through the rows of a column, group them, write a sequential value in a different c-CodePudding

I currently have an Excel spreadsheet where column B has a value that I want to identify as a group and then write that group number in column C. Column B is presorted A-Z. Here's a sample where column A is the record number, column B is text info to sort through, and column C is the sequential group created and written by this formula or sub. There are about 100,000 rows to iterate through.

A	B	C
6	ARNOLD	1
7	ARNOLD	1
8	ARNOLD	1
9	ARNOLD	1
16	DEWY	2
17	DEWY	2
18	DEWY	2
14	FOX	3
15	FOX	3
19	JAMIE	4
20	JAMIE	4

Thanks for your help - Jack

CodePudding user response：

I misread originally and I now see that your data is presorted. So to simply label the entries, the following should work for you:

Range("B:B").Select
Dim curval As Long
curval = 1
Do
    On Error Resume Next
    Selection.ColumnDifferences(ActiveCell).Select
    If Err.Number <> 0 Then
        On Error GoTo -1
        Exit Do
    End If
    Range("C" & Selection.Row) = curval
    curval = curval   1
Loop

First, we select the column and create our index variable. Then, we loop through Selection.ColumnDifferences(ActiveCell).Select. This will highlight the full set with the first entry being the selected point. Having that, we can set our column C, which would be the first row to the current index and increase the index for the next set.

Using this feature (Selection.ColumnDifferences(ActiveCell).Select) will raise an error upon completion. So, we preceed that with On Error Resume Next and follow it up by checking for the error. If it exists, we exit the loop and clear the error (On Error Goto -1).

Edit: The following should solve your issue of populating ALL as opposed to just the first entry:

Public Sub test()
Range("B:B").Select
Dim curval As Long, prev_row As Long
curval = 1
prev_row = 2
On Error Resume Next
Set first_sel = Selection.ColumnDifferences(ActiveCell)
first_sel.Select
Do
    Set second_sel = Selection.ColumnDifferences(ActiveCell)
    second_sel.Select
    If Err.Number <> 0 Then
        On Error GoTo -1
        Exit Do
    End If
    Range("C" & first_sel.Row & ":" & "C" & second_sel.Row - 1) = curval
    Set first_sel = second_sel
    curval = curval   1
Loop
End Sub