Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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... |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Search Capability | Excel Discussion (Misc queries) | |||
invoicing | Excel Discussion (Misc queries) | |||
Look-Up Capability | Excel Discussion (Misc queries) | |||
invoicing | Excel Programming | |||
Invoicing | Excel Worksheet Functions |