Solved: Auto Row Numbering

[LarryLaser]

This code, writen by lucas (http://www.vbaexpress.com/forum/member.php?u=223), is very helpful, but can some modifications be made to it?

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
ActiveSheet.Unprotect
' by lucas @vbxpress
Dim RowOffset As Long
Dim IndexCol As String
'Set values
RowOffset = 0
'Change the B to the column where you want the numbers to show
IndexCol = "B"
Intersect(ActiveCell.EntireRow, Columns(IndexCol)).Value = ActiveCell.Row + RowOffset
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub



How can I limit this code to a set of rows?
?Begin at row 5 and end at row 45?
Can the Numbering format be modified?
Example: ?RBKN3-01? to ?RBKN3-40?

[malik641]

Hey Larry,

You could add this to the top of your code (above the rest)

If Selection(1, 1).Row < 5 Or Selection.Row > 45 Then Exit Sub

Hope this helps :thumb

[Bob Phillips]

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim RowOffset As Long
Dim IndexCol As String
Const sPrefix As String = "RBKN3"

ActiveSheet.Unprotect
'Set values
RowOffset = 0
'Change the B to the column where you want the numbers to show
IndexCol = "B"
If Target.Row > 5 And Target.Row < 45 Then
Me.Cells(Target.Row, IndexCol).Value = sPrefix & _
Format(Target.Row + RowOffset, "00")
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

[malik641]

Oh yeah...and about the number formatting:

With Intersect(ActiveCell.EntireRow, Columns(IndexCol))
.Value = ActiveCell.Row + RowOffset - 4
.NumberFormat = """RBKN3-""00"
End With

:)

EDIT: oops, Bob beat me to it. Well, my code's an alternate method at least...

[LarryLaser]

Bob and Joseph
You guy's are awsome, and fast, you posted these previous Quickies whale I was working on this detailed -q??

Nice one Joseph

Here is what I have so far
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

'by malik641 @vbxpress
If Selection(1, 1).Row < 8 Or Selection.Row > 43 Then Exit Sub
ActiveSheet.Unprotect
' by lucas @vbxpress
Dim RowOffset As Long
Dim IndexCol As String
'Set values
RowOffset = -7
'Change the B to the column where you want the numbers to show
IndexCol = "B"
Intersect(ActiveCell.EntireRow, Columns(IndexCol)).Value = ActiveCell.Row + RowOffset
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub



Now I would like to modify the numbering format to get Info from other cells in the sheet,

Example: Get first Cap letters from Cells/Range's = District, School, TeacherLast, TeacherFirst, ClassRoom. then the Auto number Adds.(ERBNK3-01 thru 45 or what ever the Last student data entry.

[malik641]

Hey Larry, check this out

I made this so that the autonumber wont occur unless info has been entered all the way through (except for "pic"). I thought this was nice because the rows will not autonumber unless enough info is entered. And by the time they hit tab for "pic", it will autonumber the same row (this can be different, though).

Anyway take a look:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'by malik641 @vbxpress
If Selection(1, 1).Row < 8 Or Selection.Row > 43 Then Exit Sub

ActiveSheet.Unprotect

'This next piece makes sure that enough info is entered to actually "Autonumber" the row
Dim rng As Range
Set rng = Range("C" & Selection.Row, "L" & Selection.Row)

'Makes sure that "C#" through "L#" have info in it before continuing
Select Case True
Case rng(1, 1) = "": GoTo ExitHere
Case rng(1, 2) = "": GoTo ExitHere
Case rng(1, 3) = "": GoTo ExitHere
Case rng(1, 4) = "": GoTo ExitHere
Case rng(1, 5) = "": GoTo ExitHere
Case rng(1, 6) = "": GoTo ExitHere
Case rng(1, 7) = "": GoTo ExitHere
Case rng(1, 8) = "": GoTo ExitHere
Case rng(1, 9) = "": GoTo ExitHere
Case rng(1, 10) = "": GoTo ExitHere
End Select

Dim Acronym As String

' by lucas @vbxpress
Dim RowOffset As Long
Dim IndexCol As String
'Set values
RowOffset = -7

Acronym = Left(Range("District"), 1) + _
Left(Range("School"), 1) + _
Left(Range("TeacherLast"), 1) + _
Left(Range("TeacherFirst"), 1) + _
Left(Range("Grade"), 1) + _
"-"

'Change the B to the column where you want the numbers to show
IndexCol = "B"

Intersect(ActiveCell.EntireRow, Columns(IndexCol)).Value = ActiveCell.Row + RowOffset

With Intersect(ActiveCell.EntireRow, Columns(IndexCol))
.Value = ActiveCell.Row + RowOffset
.NumberFormat = """" & Acronym & """00"
End With

ExitHere:
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Hope this works out :thumb

[LarryLaser]

Nice one Joseph

Here it is with a couple of minor tweeks
Option Explicit
Private Sub Worksheet_Activate()
Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'by malik641 @vbxpress
If Selection(1, 1).Row < 8 Or Selection.Row > 43 Then Exit Sub

ActiveSheet.Unprotect

'This next piece makes sure that enough info is entered to actually "Autonumber" the row
Dim rng As Range
Set rng = Range("C" & Selection.Row, "L" & Selection.Row)

'Makes sure that "C#" through "L#" have info in it before continuing
Select Case True
Case rng(1, 1) = "": GoTo ExitHere
Case rng(1, 2) = "": GoTo ExitHere
Case rng(1, 3) = "": GoTo ExitHere
Case rng(1, 4) = "": GoTo ExitHere
Case rng(1, 5) = "": GoTo ExitHere
Case rng(1, 6) = "": GoTo ExitHere
Case rng(1, 7) = "": GoTo ExitHere
Case rng(1, 8) = "": GoTo ExitHere
Case rng(1, 9) = "": GoTo ExitHere
Case rng(1, 10) = "": GoTo ExitHere
End Select

Dim Acronym As String

' by lucas @vbxpress
Dim RowOffset As Long
Dim IndexCol As String
'Set values
RowOffset = -7

Acronym = Left(Range("District"), 1) + _
Left(Range("School"), 1) + _
Left(Range("TeacherLast"), 1) + _
Left(Range("TeacherFirst"), 1) + ("-") + _
Left(Range("ClassRoom"), 1) + ("-") + _
Left(Range("Grade"), 1) + _
"-"

'Change the B to the column where you want the numbers to show
IndexCol = "B"

Intersect(ActiveCell.EntireRow, Columns(IndexCol)).Value = ActiveCell.Row + RowOffset

With Intersect(ActiveCell.EntireRow, Columns(IndexCol))
.Value = ActiveCell.Row + RowOffset
.NumberFormat = """" & Acronym & """00"
End With

ExitHere:
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub


Thanks