How do I create a button and use it to generate an ascending sequential reference number on a worksheet?

0

I have no VB skills and this is an urgent query I have.

I have a spreadsheet with first column as Request ID, first free row is A2.

I need a button that will generate a number as a reference to a new request in a log/register.

It needs to insert on a new line at the top of the spreadsheet in A2 each time.

Format of Unique Reference needs to be: DSR0000001 then DSR0000002 and so on.

Please can you detail a step-by-step solution (I have no programming skills).

Thanks

Answer
Discuss

Answers

0
Selected Answer

You can try this code:

Sub newRow()

Range("A2").EntireRow.Insert shift:=xlDown

'Copy validation
Range("A3").EntireRow.Copy
Range("A2").EntireRow.PasteSpecial xlPasteValidation
Application.CutCopyMode = False

'Insert new record number
Range("A2").Value = "DSR000" & Range("B3").Value + 1
Range("B2").Value = Range("B3").Value + 1

End Sub

To make it work have a record filled-in for for A2 to start. Make Column B (so B2) contain just the number part and not DSR or anything else - you can hide that column later if you want.

If you want more zeros after DSR, edit this part of the above macro accordingly: DSR000

Update

Macro code updated.

When you run it, test it on a sheet that is like this:

A2: DSR0001

B2: 1

Test it on a sample worksheet first to make sure it works as expected.

Update 2

Macro updated to copy data validation.

Discuss

Discussion

Hi Don
Thanks for this prompt reply.  I've popped the code into the button but when I click on it, it just repeats DSR0001.
Blue Owl (rep: 2) May 15, '18 at 7:36 am
I made a small change to the code. Test it on a sample sheet first that has the value mentioned in my answer for A2 and B2.
don (rep: 1442) May 15, '18 at 8:56 am
It works perfectly, thank you!
The only problem I have now is that the data validation lists in the cells across the new line don't work.  Any ideas how to get them to work when generating the new line?
Blue Owl (rep: 2) May 15, '18 at 11:31 am
What ranges have the validation that need to be copied over? Or, just upload a sample sheet in your question and that should make it easier to understand. 
don (rep: 1442) May 16, '18 at 3:12 am
Hi
I've added worksheet inc code 'Data Subject Requests and Complaints Register' if you can have a look that would be great.
Thanks

:)
Blue Owl (rep: 2) May 21, '18 at 5:59 am
Macro updated, try it now.
don (rep: 1442) May 22, '18 at 8:24 am
Add to Discussion
0

Don was faster because I had my own idea on this, haha. You may like to try it out nevertheless. It works without a button. Just double-click A2. Your validation dropdowns and all other formatting will be preserved, except for that of the serial number which is set (unnecessarily) for each new row. The point is that you can control this format from the code in case you want to change it in future.

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' 16 May 2018
    ' insert a blank, formatted row (with formulas) at the TopRow
    
    Const TopRow As Long = 2                    ' change as required
    Const NumClm As Long = 1                    ' 1 = column A
    Const NumFormat As String = """DSR""0000000"
    ' NumFormat translates to "DSR"0000000 - change as required
    
    Dim Trigger As Range                        ' the cell to double-click
    Dim CopyRng As Range                        ' the range to copy
    Dim Cl As Long                              ' last used column
    
    Set Trigger = Cells(TopRow, "A")            ' Trigger column = "A" (can modify)
    If Target.Address = Trigger.Address Then
        Cl = Cells(TopRow, Columns.Count).End(xlToLeft).Column
        Set CopyRng = Trigger.Resize(1, Cl)
        CopyRng.Copy
        CopyRng.Insert Shift:=xlDown
        Application.CutCopyMode = 0
        
        Set CopyRng = CopyRng.Offset(-1)
        ' delete all constant values (keep formulas):-
        With CopyRng
            On Error Resume Next                ' if no constants are found
            .SpecialCells(xlCellTypeConstants).ClearContents
            On Error GoTo 0
            With .Cells(NumClm)
                .NumberFormat = NumFormat       ' set the number format
                .Value = .Offset(1).Value + 1   ' counts from the previous entry, adding 1
                .HorizontalAlignment = xlLeft
            End With
            .Cells(NumClm + 1).Select
            Cancel = True                       ' cancel normal double-click response
        End With
    End If
End Sub

To become effective, this code must be installed in the code sheet of the worksheet on which you wish to see the action. (In VBE's Project Explorer window look for "Sheet1 (Sheet1)" - unless you changed the tab's name - and double-click to open the correct code sheet on the right.)

I designed the code to make it easy for you to read and modify. You can change the insertion point (TopRow) from 2 to 3. Move the ID number to another column than A and/or move the cell on which you double-click somewhere else. I recommend that you experiment.

Discuss

Discussion

HI

I've added the spreadsheet inc code 'Book1'.  Could you have a look because it's not working for me.  I'm not sure if I've done something wrong??

Thanks :)
Blue Owl (rep: 2) May 21, '18 at 5:58 am
Two mistakes. (1) You pasted the code into a procedure. You added "Sub Macro()" at the top and "End Sub" at the bottom. That spoiled it. (2) You pasted the code into the code sheet of a module named Module1. It should be on the code sheet of the worksheet on which you want the action.
I attached a copy of the workbook used to develop the code. I also tried the corrections on your workbook and it works. There is a lot of formatting to do which is unrelated to this thread. Therefore I posted my own workbook. Note that the code in Module1 isn't required by this solution.
Variatus (rep: 1755) May 21, '18 at 7:07 am
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login