Results 1 to 10 of 10
  1. #1
    3 Star Lounger
    Join Date
    Jul 2005
    Location
    Bahrain
    Posts
    373
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Add order number

    Greetings,

    i need help with a formula that can output a data order number as shown below.

    order
    num data
    1 sam
    2 ram
    ram
    3 lam
    4 kan
    kan
    5 rom
    Last edited by dubdub; 2014-11-30 at 05:28.
    TIA
    dubdub

  2. #2
    WS Lounge VIP
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    8,191
    Thanks
    48
    Thanked 986 Times in 916 Posts
    How is the sequence determined?
    How many iterations do you need?

    cheers, Paul

  3. #3
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,639
    Thanks
    115
    Thanked 650 Times in 592 Posts
    dubdub,

    Not sure if this is what you were looking for but here is some code that will extract the data from selected cells and format them to your sample:

    DataOrder1.png

    In this example, change the destination cell indicated in the code (A12) and select your data on the worksheet. Run the code using the macro window and the formatted text will be placed on the sheet.

    HTH,
    Maud

    Code:
    Public Sub DOrder()
    'SELECT RANGE OF CELLS TO BE REFORMATTED
    '---------------------------------------
    'DECLARE AND SET VARIABLES
    Dim cell As Range
    Dim Dest As Range
    Set Dest = Range("A12")  'CHANGE TO DESTINATION CELL
    '---------------------------------------
    'CYCLE THROUGH SELECTION AND SPLIT VALUES
    For Each cell In Selection
        Num = Val(Trim(Left(cell, 1)))
        DataText = Trim(Right(cell, Len(cell) - 1))
    '---------------------------------------
    'ADD DATA ON NEXT LINE IF EVEN NUMBER
        If WorksheetFunction.IsNumber(Num) And WorksheetFunction.IsEven(Num) Then
            Dest = Num
            Dest.Offset(0, 1) = DataText
            Dest.Offset(1, 0) = DataText
            Set Dest = Dest.Offset(1, 0)
        Else:
            Dest = Num
            Dest.Offset(0, 1) = DataText
        End If
        Set Dest = Dest.Offset(1, 0)
    Next cell
    '---------------------------------------
    'CLEANUP
    Dest = vbNothing
    End Sub

  4. #4
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,639
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Using a case statement instead of If statement will achieve the same results.

    Code:
    Public Sub DOrder()
    'SELECT RANGE OF CELLS TO BE REFORMATTED
    '---------------------------------------
    'DECLARE AND SET VARIABLES
    Dim cell As Range
    Dim Dest As Range
    Set Dest = Range("A12") 'CHANGE TO DESTINATION CELL
    '---------------------------------------
    'CYCLE THROUGH SELECTION AND SPLIT VALUES
    For Each cell In Selection
        num = Val(Trim(Left(cell, 1)))
        DataText = Trim(Right(cell, Len(cell) - 1))
    '---------------------------------------
    'ADD DATA ON NEXT LINE IF EVEN NUMBER
        Select Case num Mod 2
        Case 0
            Dest = num
            Dest.Offset(0, 1) = DataText
            Dest.Offset(1, 0) = DataText
            Set Dest = Dest.Offset(1, 0)
        Case Else
            Dest = num
            Dest.Offset(0, 1) = DataText
        End Select
        Set Dest = Dest.Offset(1, 0)
    Next cell
    '---------------------------------------
    'CLEANUP
    Dest = vbNothing
    End Sub

  5. #5
    3 Star Lounger
    Join Date
    Jul 2005
    Location
    Bahrain
    Posts
    373
    Thanks
    1
    Thanked 0 Times in 0 Posts
    Great thanks to you Maudibe & Paul,
    and i am sorry i did not provide enough information in my first post. i have a list with repetitive names in column "b" and i want to assign an order number to each name in column a, excluding the repetitive names.
    TIA
    dubdub

  6. #6
    WS Lounge VIP
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    8,191
    Thanks
    48
    Thanked 986 Times in 916 Posts
    You need a counter for the numbering and a variable to which you add each name as you find it from column B, then you search the variable for an occurrence of names from column B, if the name is found you skip to the next row, if the name is not found you add the next number from the counter to column A and add the name to the variable.

    cheers, Paul

  7. #7
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts
    With the "names" in column A, I put a 1 in B1, then this formula in B2 and filled it down.

    =IF(1<COUNTIF($A$1:A2,A2),"",MAX($B$1:B1)+1)

  8. #8
    WS Lounge VIP
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    8,191
    Thanks
    48
    Thanked 986 Times in 916 Posts
    Very nice.

    cheers, Paul

  9. #9
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,639
    Thanks
    115
    Thanked 650 Times in 592 Posts
    dubdub,

    If needed, here is the adjusted code to assign order numbers. Select the range you want to run then press the Run Code button.

    HTH,
    Maud

    Before code:
    Selection1.png

    After running Code:
    Selection2.png

    Place in a standard module:
    Code:
    Public Sub FormatOrder()
    'SELECT RANGE AND RUN CODE
    '---------------------------
    'DECLARE AND SET VARIABLES
    Dim ID As Integer
    ID = 1
    '---------------------------
    'CHECK IF RANGE SELECTED
    If Selection.Count <= 1 Then MsgBox "Please select a range"
    '---------------------------
    'COMPARE EACH CELL WITH THE CELLS AFTER IT
    For I = 2 To Selection.Count
        If Cells(I, 2) = "" Then GoTo continue
        For J = I + 1 To Selection.Count + 1
            If Cells(I, 2) = Cells(J, 2) Then
    '---------------------------
    'MATCH FOUND- ASSIGN ID AND MOVE REST TO COL A
                Cells(I, 1) = ID
                Cells(J, 1) = Cells(J, 2)
                Cells(J, 2) = ""
            End If
        Next J
        ID = ID + 1
    continue:
    Next I
    [a1].Select
    End Sub
    Attached Files Attached Files

  10. #10
    3 Star Lounger
    Join Date
    Jul 2005
    Location
    Bahrain
    Posts
    373
    Thanks
    1
    Thanked 0 Times in 0 Posts
    Splendid solutions, right on the money Maudibe.
    TIA
    dubdub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •