Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Filtering results
I have Spreadhseet that contains 2 main workbooks (like databases) - on for Suppliers and one for Customers ... I have written a macro in th suppliers workbook that creates new worksheets for each different cod no and names the tab accordingly. (based o http://www.contextures.com/excelfile...epFiltered.xls) Now I want to add a macro in the Customer workbook that will do th same but put the relevant Customer data (including titles) in th relevant tab (if already created) UNDER any existing data, and als create a new tab if one hasnt been created already from the Supplie workbook. Any ideas ??? Cheers al -- GazM ----------------------------------------------------------------------- GazMo's Profile: http://www.excelforum.com/member.php...fo&userid=1461 View this thread: http://www.excelforum.com/showthread.php?threadid=26926 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Filtering results
Try this one
Copy the macro and functions in a normal module in the Customer workbook Change the sheet name and range to yours Set ws1 = Sheets("Sheet1") Set rng = ws1.Range("A1:A100") Sub Copy_With_AdvancedFilter() Dim ws1 As Worksheet Dim WSNew As Worksheet Dim rng As Range Dim cell As Range Dim Lrow As Long Dim Lr As Long Set ws1 = Sheets("Sheet1") Set rng = ws1.Range("A1:A100") 'Use a Dynamic range name, http://www.contextures.com/xlNames01.html#Dynamic 'This example filter on the first column in the range (change this if needed) With ws1 rng.Columns(1).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("IV1"), Unique:=True 'You see that the last two columns of the worksheet are used to make a Unique list 'and add the CriteriaRange.(you can't use this macro if you use this columns) Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row .Range("IU1").Value = .Range("IV1").Value For Each cell In .Range("IV2:IV" & Lrow) .Range("IU2").Value = cell.Value If SheetExists(cell.Value) = False Then Set WSNew = Sheets.Add On Error Resume Next WSNew.Name = cell.Value If Err.Number 0 Then MsgBox "Change the name of : " & WSNew.Name & " manually" Err.Clear End If On Error GoTo 0 Else Set WSNew = Sheets(cell.Value) End If Lr = LastRow(Sheets(cell.Value)) rng.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=.Range("IU1:IU2"), _ CopyToRange:=WSNew.Range("A" & Lr + 1), _ Unique:=False Next .Columns("IU:IV").Clear End With End Sub Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlValues, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function SheetExists(SName As String, _ Optional ByVal WB As Workbook) As Boolean 'Chip Pearson On Error Resume Next If WB Is Nothing Then Set WB = ThisWorkbook SheetExists = CBool(Len(WB.Sheets(SName).Name)) End Function -- Regards Ron de Bruin http://www.rondebruin.nl "GazMo" wrote in message ... I have Spreadhseet that contains 2 main workbooks (like databases) - one for Suppliers and one for Customers ... I have written a macro in the suppliers workbook that creates new worksheets for each different code no and names the tab accordingly. (based on http://www.contextures.com/excelfile...epFiltered.xls) Now I want to add a macro in the Customer workbook that will do the same but put the relevant Customer data (including titles) in the relevant tab (if already created) UNDER any existing data, and also create a new tab if one hasnt been created already from the Supplier workbook. Any ideas ??? Cheers all -- GazMo ------------------------------------------------------------------------ GazMo's Profile: http://www.excelforum.com/member.php...o&userid=14610 View this thread: http://www.excelforum.com/showthread...hreadid=269267 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
FILTERING RESULTS | Excel Worksheet Functions | |||
Getting no results from Advanced Filtering in Excel 2007 | Excel Discussion (Misc queries) | |||
Filtering results | Excel Discussion (Misc queries) | |||
filtering results to another sheet | Excel Discussion (Misc queries) | |||
sorting and filtering results | Excel Worksheet Functions |