+ Reply to Thread
Results 1 to 8 of 8

Excel Macro to increment count

Hybrid View

Stag Excel Macro to increment count 03-19-2008, 06:03 PM
protonLeah Try: In VBEditor, insert a... 03-23-2008, 04:23 PM
Stag Hi Ben, Thanks for the... 03-28-2008, 03:15 PM
protonLeah Here is a sample WB: 03-30-2008, 02:05 AM
royUK Another way would be to use a... 03-30-2008, 08:00 AM
Stag Hi Roy, Thanks I will try... 03-30-2008, 04:04 PM
Stag Ben many thanks this is... 03-30-2008, 04:02 PM
protonLeah You're welcome. Thanks for... 03-30-2008, 04:47 PM
  1. #1
    Registered User
    Join Date
    03-19-2008
    Posts
    4

    Excel Macro to increment count

    Hi I hope someone can help me.

    I am looking for a Simple Excel Macro (for Excel 2003) that will take a 4-digit number and increment it by 1 (one) each time I click it on a cell. (i.e. first cell 1000 next cell 1001 next one 1002 etc.) My problem is that the cells can be anywhere on the sheet and it is sometimes easy to lose the sequence of docket numbers and end up with a mess.

    Any help would be gratefully appreciated,

    Kind regards

    Stag

  2. #2
    Forum Guru
    Join Date
    03-02-2006
    Location
    Los Angeles, Ca
    MS-Off Ver
    Win10/MSO2016
    Posts
    12,963
    Try:
    In VBEditor, insert a new module and add
    Option Explicit
    Public kounter As Long
    In the ThisWorkbook module add
    Option Explicit
    Private Sub Workbook_Open()
          kounter = Sheets(1).Range("A65536").Value
          If kounter = 0 Then kounter = 1000
    End Sub
    
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
          Sheets(1).Range("A65536").Value = kounter
    End Sub
    In the module for the sheet add
    Option Explicit
    
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
          Dim Seq As Range
          Set Seq = Target
          Seq.Select
          Seq.Value = kounter
          kounter = kounter + 1
          Seq.Offset(0, 1).Select
    End Sub
    Ben Van Johnson

  3. #3
    Registered User
    Join Date
    03-19-2008
    Posts
    4
    Quote Originally Posted by protonLeah
    Try:
    In VBEditor, insert a new module and add
    Option Explicit
    Public kounter As Long
    In the ThisWorkbook module add
    Option Explicit
    Private Sub Workbook_Open()
          kounter = Sheets(1).Range("A65536").Value
          If kounter = 0 Then kounter = 1000
    End Sub
    
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
          Sheets(1).Range("A65536").Value = kounter
    End Sub
    In the module for the sheet add
    Option Explicit
    
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
          Dim Seq As Range
          Set Seq = Target
          Seq.Select
          Seq.Value = kounter
          kounter = kounter + 1
          Seq.Offset(0, 1).Select
    End Sub
    Hi Ben,

    Thanks for the reply. I had almost given up expecting any help.

    I am new to all of this and don't know much about VBEditor so unfortunately it looks a bit complicated. Could you email me some sort of working sample or explanation that would help me get this working.

    Once again thanks for your help

    Regards

    Stag

  4. #4
    Forum Guru
    Join Date
    03-02-2006
    Location
    Los Angeles, Ca
    MS-Off Ver
    Win10/MSO2016
    Posts
    12,963
    Here is a sample WB:
    Attached Files Attached Files

  5. #5
    Forum Expert royUK's Avatar
    Join Date
    11-18-2003
    Location
    Derbyshire,UK
    MS-Off Ver
    Xp; 2007; 2010
    Posts
    26,200
    Another way would be to use a Name. Create a Name>-Insert>-Names>-Define & in the Refers to box type =1000

    This code will then increment the stored value & add to the selected cell. Note some of the checks may not be needed

    Option Explicit
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'the following lines can be amended or deleted as suits
    'Prevent working if more than one cell is selected
    If Target.Count > 1 Then Exit Sub
    'Prevent working on empty cells
    If [Target] = vbNullString Then Exit Sub
    'prevent working on non numeric cells
    If Not IsNumeric(Target.Value) Then Exit Sub
    'only works on Column C, similarly could limit to specific Row{s}
    If Target.Column <> 3 Then Exit Sub
    'check value of name & add 1
    Target.Value = [counter] + 1
    'store new value
    ThisWorkbook.Names.Add "counter", RefersTo:="=" & Target.Value
    End Sub
    Hope that helps.

    RoyUK
    --------
    For Excel Tips & Solutions, free examples and tutorials why not check out my web site

    Free DataBaseForm example

  6. #6
    Registered User
    Join Date
    03-19-2008
    Posts
    4
    Quote Originally Posted by royUK
    Another way would be to use a Name. Create a Name>-Insert>-Names>-Define & in the Refers to box type =1000

    This code will then increment the stored value & add to the selected cell. Note some of the checks may not be needed

    Option Explicit
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'the following lines can be amended or deleted as suits
    'Prevent working if more than one cell is selected
    If Target.Count > 1 Then Exit Sub
    'Prevent working on empty cells
    If [Target] = vbNullString Then Exit Sub
    'prevent working on non numeric cells
    If Not IsNumeric(Target.Value) Then Exit Sub
    'only works on Column C, similarly could limit to specific Row{s}
    If Target.Column <> 3 Then Exit Sub
    'check value of name & add 1
    Target.Value = [counter] + 1
    'store new value
    ThisWorkbook.Names.Add "counter", RefersTo:="=" & Target.Value
    End Sub

    Hi Roy,
    Thanks I will try this also.

    Regards

    Stag

  7. #7
    Registered User
    Join Date
    03-19-2008
    Posts
    4
    Quote Originally Posted by protonLeah
    Here is a sample WB:

    Ben many thanks this is exactly what I wanted. I really do appreciate your help.

    Stag

  8. #8
    Forum Guru
    Join Date
    03-02-2006
    Location
    Los Angeles, Ca
    MS-Off Ver
    Win10/MSO2016
    Posts
    12,963
    You're welcome. Thanks for the feedback.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1