Invoicing Capability
 

Any help appreciated.

I have a database of information in Excel that needs sorting automatically
into auto generated tab sheet invoices based on values in Column A.

I have 60 Food Manufacturers populating column A with 900 entries. eg.
Cadbury appears randomly 80 times, Birds eye 30 times etc etc... I need new
sheets to be generated automatically for Cadbury, all products associated
with Cadbury listed on the sheet along with it's unit price and cost price.
Then another for Birdseye and all other manufacturers and products, without
repetition. This programming would generate 60 sheets, each being
automatically named Cadbury etc etc.

Is this easy to do, or is it best doing this in Access.

Thanks

Gordon...

Invoicing Capability
 

Try this

Code:
--------------------

Option Explicit


'---------------------------------------------------------------------------------------
' Module : Module1
' DateTime : 24/09/2006 22:48
' Author : Roy Cox (royUK)
' Website : more examples
' Purpose : Create a sheet for each unique name in data
' Disclaimer; This code is offered as is with no guarantees. You may use it in your
' projects but please leave this header intact.
'---------------------------------------------------------------------------------------

Sub ExtractToSheets()
Dim ws As Worksheet
Dim wsNew As Worksheet
Dim rData As Range
Dim rCl As Range
Dim sNm As String
Set ws = Sheet1 '<- this needs to be the data sheet

'extract a list of unique names
'first clear existing list
With ws
Set rData = .Range(.Cells(2,1), .Cells(.rows.count,1).End(xlUp))
.Columns(.Columns.Count).Clear
rData.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True

For Each rCl In .Range(.Cells(1, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))
sNm = rCl.Text
'add new sheet (only if required-NB uses UDF)
If WksExists(sNm) Then
'so clear contents
Sheets(sNm).Cells.Clear
Else
'new sheet required
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count) 'move to end
wsNew.Name = sNm
End If
'AutoFilter & copy to relevant sheet
rData.AutoFilter Field:=2, Criteria1:=sNm
rData.Copy Destination:=Worksheets(sNm).Cells(1, 1)
Next rCl
End With
ws.Columns(Columns.Count).ClearContents 'remove temporary list
rData.AutoFilter 'switch off AutoFilter
End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function
--------------------


--
royUK

Hope that helps, RoyUK
For tips & examples visit my 'web site' (http://www.excel-it.com/)
------------------------------------------------------------------------
royUK's Profile: http://www.thecodecage.com/forumz/member.php?userid=15
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=38237