VBA increment number in qualifying cell on paste

Question

I have a macro that pastes a number of rows from a "Template" sheet into the next blank row on the active sheet.

In column 2 of the first row is the value "variable". In Column 6 of the first row is a 3 digit number.

What I am wanting to do is increment the number in Column 6 by 1 when it is pasted. If there is no previous number on the active sheet, then it starts with 001.

As the sheet has other rows that don't contain numbers, and the rows with numbers are not at regular intervals, I am thinking the cell to increment needs to be determined in the following way (unless there is an easier logic) :

In Active Sheet, find last row in Column 2 that has value "variable". Offset Column by 4, to get to cell in Column 6.
Take active cell value and increment by 1 in the pasted rows, using the same criteria as above to determine which cell.
If there is no previous value of "variable" in Column 2 then value=001.

Here is the code I use to paste below into the next blank row.

Sub Paste_New_Product_from_Template()
  Application.ScreenUpdating = False
  Dim copySheet As Worksheet
  Dim pasteSheet As Worksheet

  Set copySheet = Worksheets("Template")
  Set pasteSheet = ActiveSheet

  copySheet.Range("2:17").Copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).OFFSET(1, 0).PasteSpecial xlPasteAll
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

How could I incorporate the incrementing of numbers mentioned above?

EDIT

This is a sample of what the rows would look like on the Template sheet

And this is what the rows look like on Sheet1

user_1140579 · Answer

Yes only incrementing Row 6. If no data in sheet then numbering starts from 001. Each sheet has independent numbering. If sheet has data then numbering starts from pasted row e.g. row 10. – aye cee

Let's say our sample data looks like this

LOGIC:

Set your input/output sheets.
Find the last cell to write to in the output sheet. Have to check if there is data previously or not.
If there is no data then copy across the header row.
Copy the range.
Ascertain the next number to be written in column 6.
Enter the number in the relevant cell in column 6 of the copied data and apply the 000 format.

CODE:

Is this what you are trying? I have commented the code so you should not have a problem understanding it but if you do them simply ask :)

Option Explicit

Sub Paste_New_Product_from_Template()
    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet
    Dim LRow As Long, i As Long
    Dim StartNumber As Long
    Dim varString As String
    
    '~~> This is your input sheet
    Set copySheet = Worksheets("Template")
    '~~> Variable
    varString = copySheet.Cells(2, 2).Value2
    
    '~~> Change this to the relevant sheet
    Set pasteSheet = Sheet2
    
    '~~> Initialize the start number
    StartNumber = 1
    
    With pasteSheet
        '~~> Find the last cell to write to
        If Application.WorksheetFunction.CountA(.Cells) = 0 Then
            '~~> Copy header row
            copySheet.Rows(1).Copy .Rows(1)
            LRow = 2
        Else
            LRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            
            '~~> Find the previous number
            For i = LRow To 1 Step -1
                If .Cells(i, 2).Value2 = varString Then
                    StartNumber = .Cells(i, 6).Value2 + 1
                    Exit For
                End If
            Next i
        End If
        
        '~~> Copy the range
        copySheet.Range("2:17").Copy .Rows(LRow)
        
        '~~> Set the start number
        .Cells(LRow, 6).Value = StartNumber
        '~~> Format the number
        .Cells(LRow, 6).NumberFormat = "000"
    End With
End Sub

IN ACTION

VBA increment number in qualifying cell on paste

1 Answers