Code and more code...

[Andrew_Rossington]

Hello.

My question is two-fold.

One: I have a table on a worksheet - simple stuff. I'm looking for some code to launch Data > Form (y'know, for adding new records and such). I tried the excel help, but it's not very helpful. Would anyone be able to point me in the right direction?

Two: Based on the above need, does anyone know how to automatically populate a column with a consecutive number for each new record added? (Kind of like a unique ID for each record, whereby if the latest record is number 5, I add a new one and this column has number 6 automatically entered.)

I'd be very grateful for any help with this.

Thanks.

 

[Andrew_Rossington]

Are you sure you want this to run every time you change the selection or every time you make a change to a cell?

At any rate

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ce As Range, LstRw As Long

LstRw = Cells(Rows.Count, "B").End(xlUp).Row
For Each Ce In Range("B4:B" & LstRw)
    If Len(Ce.Value) = 0 Then
        Range("A" & Ce.Row).Value = vbNullString
    Else
        Range("A" & Ce.Row).Formula = "=Row() - 3"
    End If
Next Ce

End Sub

Hope this helps!

Just when I thought it was working!

For some reason, this code seems to be working fairly erratically.

I've changed parts of the code to match my needs, however now it doesn't seem to work 100% of the time. If I enter a value in B4 and then B5, then delete both of them; the formula stays in A5 even though B5 has nothing in the cell.

Does anyone know why this happens?

 

[brian.wethington]

There is an issue there of the deletion Perhaps something like. I also took care of another problem that I happened to notice. Hope this helps you out.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ce As Range, LstRw As Long

Application.Screenupdating = False
LstRw = Cells(Rows.Count, "B").End(xlUp).Row
LstRw2 = Cells(Rows.Count, "A").End(xlUp).Row
If LstRw < LstRw2 Then LstRw = LstRw2
If LstRw < 4 Then Exit Sub
For Each Ce In Range("B4:B" & LstRw)
    If Len(Ce.Value) = 0 Then
        Range("A" & Ce.Row).Value = vbNullString
    Else
        Range("A" & Ce.Row).Formula = "=Row() - 3"
    End If
Next Ce
Application.Screenupdating = True

End Sub

 

[Andrew_Rossington]

There is an issue there of the deletion Perhaps something like. I also took care of another problem that I happened to notice. Hope this helps you out.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ce As Range, LstRw As Long

Application.Screenupdating = False
LstRw = Cells(Rows.Count, "B").End(xlUp).Row
LstRw2 = Cells(Rows.Count, "A").End(xlUp).Row
If LstRw < LstRw2 Then LstRw = LstRw2
If LstRw < 4 Then Exit Sub
For Each Ce In Range("B4:B" & LstRw)
    If Len(Ce.Value) = 0 Then
        Range("A" & Ce.Row).Value = vbNullString
    Else
        Range("A" & Ce.Row).Formula = "=Row() - 3"
    End If
Next Ce
Application.Screenupdating = True

End Sub

Thank you very much for this. You'll be happy to know it's working perfectly.