Generate unique numbers

[STEEL010]

Hi There,


I have a challenging question....


I have an existing macro that split the mastersheet into splitted sheets in the same workbook and it saves also the splitted sheet.
And now I want that it generate for every splitted sheet a unique number in a cell with an prefix like "invoice" and that the last created unique number will generated in mastersheet so it goes on in the future with the last number and counting.


Is this possible?



Greetings,


Steel010

 

[James006]

Hi,

Your question is ... rather generic ...

With Excel ... everything is possible ... so, the short answer is : Yes :wink:

 

[STEEL010]

ok super....... but how

 

[STEEL010]

This is the splitcode, where and how can I wright the code to generate an unique automatic numbering

Sub Split()
Dim Cl As Range
Dim ws As Worksheet
Dim Ky As Variant

Application.ScreenUpdating = False
Set ws = Sheets("Invoice")
With CreateObject("scripting.dictionary")
For Each Cl In ws.Range("D2", ws.Range("D" & Rows.Count).End(xlUp).Offset(-1))
If Not .Exists(Cl.Value) And Cl.Value <> "" Then .Add Cl.Value, Nothing
Next Cl
For Each Ky In .Keys
ws.Range("A1").AutoFilter 4, Ky
Sheets.Add(, ws).Name = Ky
ws.AutoFilter.Range.EntireRow.Copy Sheets(Ky).Range("A1")
Sheets(Ky).Columns.AutoFit
Next Ky
End With
ws.AutoFilterMode = False
ws.Activate

 

[James006]

Hi again

[COLOR=#333333]Sub Split()[/COLOR]
[COLOR=#333333]Dim Cl As Range[/COLOR]
[COLOR=#333333]Dim ws As Worksheet[/COLOR]
[COLOR=#333333]Dim Ky As Variant[/COLOR]

[COLOR=#333333]Application.ScreenUpdating = False[/COLOR]
[COLOR=#333333]Set ws = Sheets("Invoice")[/COLOR]
[COLOR=#333333]With CreateObject("scripting.dictionary")[/COLOR]
[COLOR=#333333]For Each Cl In ws.Range("D2", ws.Range("D" & Rows.Count).End(xlUp).Offset(-1))[/COLOR]
[COLOR=#333333]If Not .Exists(Cl.Value) And Cl.Value <> "" Then .Add Cl.Value, Nothing[/COLOR]
[COLOR=#333333]Next Cl[/COLOR]
[COLOR=#333333]For Each Ky In .Keys[/COLOR]
[COLOR=#333333]ws.Range("A1").AutoFilter 4, Ky[/COLOR]
[COLOR=#333333]Sheets.Add(, ws).Name = Ky[/COLOR]
[COLOR=#333333]ws.AutoFilter.Range.EntireRow.Copy Sheets(Ky).Range("A1")[/COLOR]
[COLOR=#333333]Sheets(Ky).Columns.AutoFit
[/COLOR]' Next Instruction will add your Unique Number '''''''''''''''''''''''''''''''''''''''''
' You need to determine both the Destination such as cell Z1 and Source such as cell AA1 in Sheets Invoice 
[COLOR=#333333]Sheets(Ky).Range("Z1").value = ws.Range("AA1").value + 1
' Ensure the Number is properly adjusted
[/COLOR][COLOR=#333333]ws.Range("AA1").value + 1 = [/COLOR][COLOR=#333333]ws.Range("AA1").value + 1[/COLOR][COLOR=#333333]
[/COLOR]
[COLOR=#333333]Next Ky[/COLOR]
[COLOR=#333333]End With[/COLOR]
[COLOR=#333333]ws.AutoFilterMode = False[/COLOR]
[COLOR=#333333]ws.Activate[/COLOR]

Hope this will help

 

[STEEL010]

James,

it give me an error of "invalid use of property"

Sub Split()
Dim Cl As Range
Dim ws As Worksheet
Dim Ky As Variant

Application.ScreenUpdating = False
Set ws = Sheets("Invoice")
With CreateObject("scripting.dictionary")
For Each Cl In ws.Range("D2", ws.Range("D" & Rows.Count).End(xlUp).Offset(-1))
If Not .Exists(Cl.Value) And Cl.Value <> "" Then .Add Cl.Value, Nothing
Next Cl
For Each Ky In .Keys
ws.Range("A1").AutoFilter 4, Ky
Sheets.Add(, ws).Name = Ky
ws.AutoFilter.Range.EntireRow.Copy Sheets(Ky).Range("A1")
Sheets(Ky).Columns.AutoFit
' Next Instruction will add your Unique Number '''''''''''''''''''''''''''''''''''''''''
' You need to determine both the Destination such as cell Z1 and Source such as cell AA1 in Sheets Invoice
Sheets(Ky).Range("G1").Value = ws.Range("H1").Value + 1
' Ensure the Number is properly adjusted
ws.Range("H1").Value 1 = ws.Range("H1").Value + 1
Next Ky
End With
ws.AutoFilterMode = False
ws.Activate

 

[STEEL010]

James,

got it working, but my prefix is not appearing? "INVOICE-0001" like this.

 

[James006]

Hi,

[COLOR=#333333]Sub Split()[/COLOR]
[COLOR=#333333]Dim Cl As Range[/COLOR]
[COLOR=#333333]Dim ws As Worksheet[/COLOR]
[COLOR=#333333]Dim Ky As Variant[/COLOR]

[COLOR=#333333]Application.ScreenUpdating = False[/COLOR]
[COLOR=#333333]Set ws = Sheets("Invoice")[/COLOR]
[COLOR=#333333]With CreateObject("scripting.dictionary")[/COLOR]
[COLOR=#333333]For Each Cl In ws.Range("D2", ws.Range("D" & Rows.Count).End(xlUp).Offset(-1))[/COLOR]
[COLOR=#333333]If Not .Exists(Cl.Value) And Cl.Value <> "" Then .Add Cl.Value, Nothing[/COLOR]
[COLOR=#333333]Next Cl[/COLOR]
[COLOR=#333333]For Each Ky In .Keys[/COLOR]
[COLOR=#333333]ws.Range("A1").AutoFilter 4, Ky[/COLOR]
[COLOR=#333333]Sheets.Add(, ws).Name = Ky[/COLOR]
[COLOR=#333333]ws.AutoFilter.Range.EntireRow.Copy Sheets(Ky).Range("A1")[/COLOR]
[COLOR=#333333]Sheets(Ky).Columns.AutoFit[/COLOR]
[COLOR=#333333]' Next Instruction will add your Unique Number '''''''''''''''''''''''''''''''''''''''''[/COLOR]
[COLOR=#333333]' You need to determine both the Destination such as cell Z1 and Source such as cell AA1 in Sheets Invoice[/COLOR]
[COLOR=#333333]Sheets(Ky).Range("G1").Value = "[/COLOR][COLOR=#333333]INVOICE-[/COLOR][COLOR=#333333]" & ws.Range("H1").Value + 1[/COLOR]
[COLOR=#333333]' Ensure the Number is properly adjusted[/COLOR]
[COLOR=#333333]ws.Range("H1").Value 1 = ws.Range("H1").Value + 1[/COLOR]
[COLOR=#333333]Next Ky[/COLOR]
[COLOR=#333333]End With[/COLOR]
[COLOR=#333333]ws.AutoFilterMode = False[/COLOR]
[COLOR=#333333]ws.Activate
[/COLOR]End Sub

Hope this will help

 

[STEEL010]

Hi James,

its working splendid thank you for your help

 

[James006]

You are welcome ...:wink: