-
Solved: Auto Row Numbering
This code, writen by lucas, is very helpful, but can some modifications be made to it?
[vba]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
[/vba]
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?
LarryLaser
neogeek in training
-
-
[vba]
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
[/vba]
-
-
Re: Auto Row Numbering
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
[vba]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
[/vba]
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.
Last edited by LarryLaser; 10-10-2006 at 01:23 PM.
LarryLaser
neogeek in training
-
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:
[VBA]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[/VBA]
Hope this works out
New to the forum? Check out our Introductions section to get to know some of the members here. Feel free to tell us a little about yourself as well.
-
Nice one Joseph
Here it is with a couple of minor tweeks
[VBA]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
[/VBA]
Thanks
LarryLaser
neogeek in training
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules