I am a having an issue in Excel using VBA code to number rows after a multi row paste operation

Question

I have a number of data sources that I need to bring into excel for analysis. I start each data set by pasting a one line header on Row 1 starting in Column B that will go to Column "X" (each source has a different number of columns). Column A Row 1 I manually type a reference code for the page the data was found.

Each page of the original data set contains multiple lines of data, while each line is formatted the same there is different values.

I can manually paste the data into excel starting on Column B, then go to Column A by the first new row and put the page number then auto fill down or drag to the end of that set.

However I would like to set some VBA code to auto fill the page number based on an incremental value increas of 1.

Not all paste operations will have the same number of rows but each set is the same page. For example page 5 might be 9 rows that need to be labeled page 5, then page 6 might have 25 rows.

I tried the code below...which may be repetitive and not the most refined but it almost got me there.

This code allows me to paste my header Row into Row 1 starting in Cell B1 and type in A1 without triggering any errors.

I can then paste my rows of data into Excel into cell B2 and Excel understands that the paste operation is multiple rows and labels A2-A# with the value 1 based on the number of rows I inserted.

However this is where I am stuck if I paste the next set of data into B# ( the next blank row below where my last set ended) Excel still puts a 1 next to all the new rows instead of a 2.

I would like the code to verify the value used in Column A for the last set then increase by an increment of 1 for the next set.

Any help would be appreciated.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim i As Integer
    Dim lastRowB As Long
    Dim firstBlankCellA As Range
    Dim firstBlankCellB As Range
    
    Set rng = Range("B:B")
    
    ' Exit if the row being edited is row 1 (Title Row)
    If Target.Row = 1 Then Exit Sub
    
    ' Find the last row with data in column B
    lastRowB = Cells(Rows.Count, "B").End(xlUp).Row
    
    ' Find the next blank cell in column A
    Set firstBlankCellA = Cells(lastRowB + 1, "A")
    
    ' Find the next blank cell in column B
    Set firstBlankCellB = Cells(lastRowB + 1, "B")
    
    If Not Intersect(Target, rng) Is Nothing Then
        ' If the cell two rows above the first blank cell in Column A exists and is preceded by a number,
        ' use the next numerical value for all rows with new text
        If firstBlankCellA.Row > 2 And IsNumeric(firstBlankCellA.Offset(-2, 0).Value) Then
            i = firstBlankCellA.Offset(-2, 0).Value + 1
        Else
            i = 1
        End If
        
        ' Add the numerical value to each row with new text
        For Each cell In Target.Cells
            If cell.Value <> "" And cell.Offset(0, -1).Value = "" Then
                cell.Offset(0, -1).Value = i
            End If
        Next cell
        
        ' Select the first blank cell in column A for the next paste job
        If Target.Rows.Count > 1 Then
            i = i + Target.Rows.Count - 1
        End If
        firstBlankCellA.Offset(1, 0).Select
        firstBlankCellB.Offset(1, 0).Select
        
        ' Select the first blank cell in column B
        Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Select
    End If
End Sub

Answer 1

This does not find the next blank cell in column A

' Find the next blank cell in column A
Set firstBlankCellA = Cells(lastRowB + 1, "A")

Try replacing the first part of your code with this:

Set rng = Range("B:B")

' Exit if the row being edited is row 1 (Title Row)
If Target.Row = 1 Then Exit Sub

' Find the last row with data in column A
lastRowA = Cells(Rows.Count, "A").End(xlUp).Row

' Find the last row with data in column B
lastRowB = Cells(Rows.Count, "B").End(xlUp).Row

' Find the next blank cell in column A
Set firstBlankCellA = Cells(lastRowA + 1, "A")

' Find the next blank cell in column B
Set firstBlankCellB = Cells(lastRowB + 1, "B")

Answer 2

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Integer, num As Integer
Application.EnableEvents = False
If Target.Column = 2 Then
    r = Target.Rows.Count
    If Application.CountA(Target) = 0 And Target.Row > 1 Then
        Target.Resize(r, 1).Offset(0, -1).ClearContents
    Else
        With Range("A" & Rows.Count).End(xlUp)
            If .Row = 1 Then num = 1 Else num = .Value + 1
            .Offset(1, 0).Resize(r, 1).Value = num
        End With
    End If
End If
Application.EnableEvents = True
End Sub

First it check, if the change happen in column B then it will do the operation, if not then it just exit the sub.

The operation:
it get how many rows of the target which is changed into r variable.

Than it check if the countA of the target = 0 (meaning a user clear the content of row/rows in column B) then it will also clear the content in column A as many as the rows which is cleared the content in column B.

If the countA is not 0 (meaning, a user paste a data into column B) then it will first check if that is the "first time" data in the sheet by checking if the last row with data in column A is 1 then put 1 to num variable, if not row 1 then add that last row value + 1 to num variable. Then finaly it fill column A with num value as many as the r value (the rows count of the target).

The copied data is from a table in a website page in the image below:

If the expected result is not an increment number, but random number which only "god" knows the manually pasted data to the sheet is coming from what page number of outside source, then just have the num variable as an input box. Something like num = application.inputbox("please type the page number of the pasted data") and remove some unnecessary line of codes.