Amend code or change it completely?

  • Thread starter Thread starter Gareth
  • Start date Start date
G

Gareth

A couple of months ago I asked for help with some code to produce an ID
number in column A of my sheet. The code below is the result:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'ID number in column A
Dim rng As Range, rng1 As Range
On Error GoTo errhandler
If Target.Column = 2 Then
Application.EnableEvents = False
Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
Set rng = rng.Offset(0, -1)
If Intersect(rng, Cells(1, 1)) Is Nothing Then
On Error Resume Next
Set rng1 = rng.SpecialCells(xlBlanks)
On Error GoTo errhandler
If Not rng1 Is Nothing Then
rng.Formula = "=Row()-1"
rng.Formula = rng.Value
End If
Else
Target.Offset(0, -1).Value = Target.Row - 1
End If
End If
errhandler:
Application.EnableEvents = True
End Sub

This is basically what it does:
Up to 20,000 rows of data may be copied into cell B2, the code then puts an
ID number alongside in column A. Users may add data at the bottom and an ID
number will be created for it.

It came to light today that if users sort the data and then add data, the ID
numbers are put into ascending order! I do not want this to happen as the
original ID of the row is crucial. This is very hard to explain, perhaps
you could try out the code to see what I mean.

What I want the code to do is:
Add an ID number for copied in data and add ID's for additional data typed
in.

Thanks in advance.

Gareth
 
Gareth,

How about this approach? What it does is to take the maximum value in column
A, and increment it by 1 and store that. I tested it by sorting column B and
it seemed to work ok.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'ID number in column A
Dim rng As Range, rng1 As Range
On Error GoTo errhandler
If Target.Column = 2 Then
Application.EnableEvents = False
Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
Set rng = rng.Offset(0, -1)
If Intersect(rng, Cells(1, 1)) Is Nothing Then
On Error Resume Next
Set rng1 = rng.SpecialCells(xlBlanks)
On Error GoTo errhandler
If Not rng1 Is Nothing Then
rng1.Value = Application.Max(Range("A:A")) + 1
End If
Else
Target.Offset(0, -1).Value = Target.Row - 1
End If
End If
errhandler:
Application.EnableEvents = True
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'ID number in column A
Dim rng As Range, rng1 As Range
Dim cell As Range, val As Long
Dim rngB As Range
On Error GoTo errhandler
If Target.Column = 2 Then
Application.EnableEvents = False
Set rngB = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
Set rng = rngB.Offset(0, -1)
val = Application.Max(rng)
If Intersect(rng, Cells(1, 1)) Is Nothing Then
On Error Resume Next
Set rng1 = rng.SpecialCells(xlBlanks)
On Error GoTo errhandler
If Not rng1 Is Nothing Then
For Each cell In rng1
val = val + 1
cell.Formula = val
Next
End If
End If
End If
errhandler:
Application.EnableEvents = True
End Sub


Might do what you want.
 
Back
Top