Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

How to Find Unique Bills Serial Number

0

Bill no   account   unique acc     total bills               ( i want to find all bill number of uique 

1            12345       12345               1,5                             account ist )

2             54321      54321               2,4

3             09876      09876               3

4             54321

5             12345

Post Edited
Title: Title was not descriptive.
Answer
Discuss

Answers

0

You will be better off using VBA for this task. Paste the following code in a standard code module (by default "Module1"). Run the code by placing the cursor anywhere within the procedure "WriteNumbers" and press F5, or press 'Macros' on the Ribbon's Developer tab, select "WriteNumbers" and press "Run".

Option Explicit

' Enumerations without assigned value take the value of the previous + 1
Private Enum Nws                    ' Worksheet navigation
    ' 03 Aug 2017
    NwsFirstDatarow = 2
    NwsBill = 1                     ' columns: 1 = A
    NwsAcc
    NwsUnique = 5
    NwsCollect
End Enum

Sub WriteNumbers()
    ' 03 Aug 2017
    
    Dim Ws As Worksheet
    Dim Target As Range             ' output range
    Dim Acc As String               ' account number
    Dim Spike() As Variant          ' collect unique account numbers
    Dim i As Long                   ' counter for Spike()
    Dim Coll() As String            ' collect bill numbers
    Dim ix As Long                  ' index for Spike() and Coll()
    Dim Rl As Long                  ' last row
    Dim R As Long                   ' row counter
    
    Set Ws = ActiveSheet            ' better specify Ws by name
    With Ws
        Rl = .Cells(.Rows.Count, NwsBill).End(xlUp).Row
        ReDim Spike(1 To Rl + 1)
        ReDim Coll(1 To Rl + 1)
        
        For R = NwsFirstDatarow To Rl
            Acc = Trim(.Cells(R, NwsAcc).Value)
            On Error Resume Next
            ix = WorksheetFunction.Match(Acc, Spike, 0)
            If Err Then
                i = i + 1
                Spike(i) = Acc
                ix = i
                Err = 0
            End If
            If Len(Coll(ix)) Then Coll(ix) = Coll(ix) & ", "
            Coll(ix) = Coll(ix) & Trim(.Cells(R, NwsBill).Value)
        Next R
    
        ReDim Preserve Spike(1 To i)
        ReDim Preserve Coll(1 To i)
        Application.ScreenUpdating = False
        Set Target = .Range(.Cells(NwsFirstDatarow, NwsUnique), _
                            .Cells(NwsFirstDatarow + i - 1, NwsUnique))
        With Target
            .NumberFormat = "@"
            .Value = Application.Transpose(Spike)
            Set Target = .Offset(0, NwsCollect - NwsUnique)
        End With
        
        With Target
            .NumberFormat = "@"
            .Value = Application.Transpose(Coll)
        End With
        Application.ScreenUpdating = False
    End With
End Sub

Observe that the columns are controlled by the enumerations at the top. If you need to make changes you might want to read up on "Enums" or "VBA Enumerations" on the Internet. With the current settings, the result will be written to columns 5 and 6 (NwsUnique and NwsCollect = columns E and F). To match your sample, you should change the value of NwsUnique = 3 which will automatically assign 4 to the enumeration NwsCollect, and the result would be written to columns C and D.

Discuss


Answer the Question

You must create an account to use the forum. Create an Account or Login