Arrange and differentiate

[Closed]
Report
-
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
-
Hello,
I have my data like this

for example
on-2006-012
on-2006-011
on-2006-010
off-2007-012
off-2007-011
kn-2009-015
kn-2009-014

i want the invoices to be arranged in ascending order i want once cell gap after every set of invoices. i.e., the result should be

on-2006-010
on-2006-011
on-2006-012

off-2007-011
off-2007-012

kn-2009-014
kn-2009-015

Can any one help me please.

4 replies

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
How the invoice are sorted ?

on-2006-012

off-2007-012

kn-2009-014

if you want it sorted, how kn is below on ?
Hello,

The invoices should be sorted in ascending order and I need one row gap in between the set of invoices and should also check whether there is any missing invoice number in between

For example,
I have a data like this

On-2006-012
On-2006-013
Off-2007-014
Off-2007-011
Off-2007-012
Kn-2009-016
Kn-2009-012
On-2008-012
On-2007-016
Off-2008-014
Off-2008-012
Kn-2010-022



Then the result should be like this

Kn-2009-012
Kn-2009-016

Kn-2010-022

Off-2007-011
Off-2007-012
Off-2007-014

Off-2008-012
Off-2008-014

On-2006-012
On-2006-013

On-2007-016
On-2008-012

The main thing which I want is there should be a gap of one row wherever the invoice changes. i.e., after kn-2009-016 there should be a gap to clearly identify that the invoice year and the location from where it is raised (i.e, on, off, kn) and each set of invoices should be in ascending order.
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
Try this

Sub GroupData()
Dim lMaxRows As Long
Dim lStartRow As Long
Dim CellR As Range
Dim CellC As Range
Dim iCol As Integer
Dim lRow As Long

    lStartRow = 1
    
    Set CellC = Cells.Find("*", Cells(1, 1), , , xlByColumns, xlPrevious)
    Set CellR = Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious)
    
    If CellR Is Nothing Then GoTo End_Sub
    
    iCol = CellC.Column
    lMaxRows = CellR.Row
     
    Cells(lStartRow, iCol + 1) = "Temp Loc"
    Cells(lStartRow, iCol + 2) = "Temp Area"
    Cells(lStartRow, iCol + 3) = "Temp Date"
   
    
    With Range(Cells(lStartRow + 1, iCol + 1), Cells(lMaxRows, iCol + 1))
        .NumberFormat = "general"
        .FormulaR1C1 = "=IF(RC1= """", """", IF(ISERROR(FIND(""-"",RC1, 1)),LEN(RC1),FIND(""-"",RC1, 1)))"
        .Copy
        .PasteSpecial xlPasteValues
    End With
    
    With Range(Cells(lStartRow + 1, iCol + 2), Cells(lMaxRows, iCol + 2))
        .NumberFormat = "general"
        .FormulaR1C1 = "=IF(RC1 = """", """", LEFT(RC1, RC" & iCol + 1 & "))"
        .Copy
        .PasteSpecial xlPasteValues
    End With

    With Range(Cells(lStartRow + 1, iCol + 3), Cells(lMaxRows, iCol + 3))
        .NumberFormat = "general"
        .FormulaR1C1 = "=IF(OR(RC1="""",RC" & iCol + 1 & "=LEN(RC1)),"""",MID(RC1,RC" & iCol + 1 & " + 1,LEN(RC1)))"
        .Copy
        .PasteSpecial xlPasteValues
    End With

    Range(Cells(lStartRow, "A"), Cells(lMaxRows, iCol + 3)).Sort _
                    Key1:=Cells(lStartRow + 1, iCol + 2), Order1:=xlAscending, _
                    Key2:=Cells(lStartRow + 1, iCol + 3), Order2:=xlAscending, _
                    Header:=xlGuess
                    
    Set CellR = Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious)
    lMaxRows = CellR.Row
    
    lRow = lMaxRows - 1
    
    Do While lRow > lStartRow
        
        If Cells(lRow, iCol + 2) = "" Then
            ' cell is blank
        
        ElseIf ((Cells(lRow, iCol + 2) <> Cells(lRow + 1, iCol + 2)) _
            Or (Left(Cells(lRow, iCol + 3), 4) <> Left(Cells(lRow + 1, iCol + 3), 4))) Then
            
            'change in area or date
            Rows(lRow + 1).Insert
            lMaxRows = lMaxRows + 1
            
        End If
        
        lRow = lRow - 1
    Loop
End_Sub:
    
    Set CellC = Nothing
    Set CellR = Nothing
    Application.CutCopyMode = False
    Range(Cells(lStartRow, iCol + 1), Cells(lMaxRows, iCol + 3)).ClearContents
    
End Sub
sorry, it didn't solve my problem. After running the macro all the "kn " invoices should be arranged in ascending order and one row gap should be there and then "off" invoices should be in ascending order and once row gap should be there. Then after the " on" invoices should be arranged in ascending order. But after running the macro which u have sent the result is not like that.
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
Could you post on a shared site a sample workbook, Please include the macro that you are using. And have two sheets in it. One sheet should show how the data is now. and one to show how you would like data to show up. Post the link to the book back here. You can use https://authentification.site , http://docs.google.com, http://wikisend.com/ , etc. Just dont forget to post back the link