Need a macro

[Closed]
Report
-
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
-
Hello,

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.



1 reply

Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
801
the data is sheet 1 like this

INVOICE
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

1. as you are messing up with dta <gras>COPY THIS DATA IN SHEET 3 FROM A1.</gras>
TO BE ON SAFE SIDE SAVE THE FILE SOMEWEHRE SO THAT IT CAN BE RETRIEVED.

2. RUN THE MACRO "TEST"

the second macro "undo" is to undo the result of the macro "test"

may be the macro is pedestrian. but it works.
==================
Sub test()
Dim r As Range, j As Integer, k As Integer
Set r = Range(Range("A1"), Range("A1").End(xlDown))

r.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
ConsecutiveDelimiter:=False, other:=True, otherchar:= _
"-"
Set r = Range("A1").CurrentRegion
'MsgBox r.Address
r.Sort key1:=Range("a1"), key2:=Range("B1"), order2:=xlAscending, key3:=Range("c1"), order3:=xlAscending
j = Cells(Rows.Count, 1).End(xlUp).Row
For k = j To 2 Step -1
If Cells(k, 1) <> Cells(k - 1, 1) Then
Cells(k, 1).EntireRow.Insert
End If
Next k
j = Cells(Rows.Count, 1).End(xlUp).Row
For k = j To 2 Step -1
If Cells(k - 1, 2) <> Cells(k, 2) Then
Cells(k, 2).EntireRow.Insert
End If
Next k
j = Cells(Rows.Count, 1).End(xlUp).Row
For k = j To 2 Step -1
If Cells(k, 1) = "" And Cells(k - 1, 1) = "" Then
Cells(k, 1).EntireRow.Delete
End If
Next
j = Cells(Rows.Count, 1).End(xlUp).Row
For k = j To 2 Step -1
If Cells(k, 1) <> "" Then
Cells(k, 1) = Cells(k, 1) & "-" & Cells(k, 2) & "-" & Cells(k, 3)
End If
Next
Range("B1:c1").EntireColumn.Delete
Range("A1").EntireColumn.AutoFit
Range("A2").EntireRow.Delete
End Sub

=========================
YOUR COMMENTS PLEASE
Sub undo()
Worksheets("sheet1").Cells.Clear
Worksheets("sheet3").UsedRange.Copy Worksheets("sheet1").Range("A1")
End Sub
==============================