Consulting

Results 1 to 7 of 7

Thread: Solved: Auto Row Numbering

  1. #1

    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

  2. #2
    Administrator
    2nd VP-Knowledge Base
    VBAX Master malik641's Avatar
    Joined
    Jul 2005
    Location
    Florida baby!
    Posts
    1,533
    Location
    Hey Larry,

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

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

    Hope this helps




    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.

  3. #3
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    [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]

  4. #4
    Administrator
    2nd VP-Knowledge Base VBAX Master malik641's Avatar
    Joined
    Jul 2005
    Location
    Florida baby!
    Posts
    1,533
    Location
    Oh yeah...and about the number formatting:

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



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




    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.

  5. #5

    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

  6. #6
    Administrator
    2nd VP-Knowledge Base VBAX Master malik641's Avatar
    Joined
    Jul 2005
    Location
    Florida baby!
    Posts
    1,533
    Location
    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.

  7. #7
    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
  •