Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Please help me edit this code..Thanks in advance :-)
If you're trying to modify Debra Dalgleish's routine so that it's more
automatic--you type the name into a cell in the master worksheet and the appropriate worksheet gets updated with the change, then I wouldn't do it. If you make a typing error and the data gets copied to a different sheet, it may be difficult to correct. If you change the cells in the wrong order and the row gets copied to the correct sheet--but with incomplete information, it could be a pain. I'd do my best to keep the data in a single worksheet. And use data|filter to show just what I needed. But if I needed to separate the data into individual worksheets, I'd run that macro each time and refresh those "child" worksheets. And those child worksheets would be for reporting only. No changes made to those sheets would be reflected in the master worksheet. jhong wrote: Hi Everyone, I found this code from http://www.contextures.com/excelfiles ref FL0009, this macro is really good. The macro works by updating all sheets when a new entry is updated in the main sheet. In the column A of the main sheet the sheet you can find the list of sheet name accross the file, so when you add changes, you provide the sheet name and value then the changes will be sent to the corresponding sheet name. I am no good in vba, hope you can help me to edit this code to be useful in my current work dilemma. Assuming that the column A of Main sheet is not the sheet name of the other sheets but a row name from the other sheets. And that any addition or changes from the rows of main sheet will be updated to the other sheets of the workbook, including the exect row number to specific. Column names from all sheets including the main sheets the same. Thanks to http://www.contextures.com/excelfiles for providing good materials!! Thanks in advance! Jerome Sub FilterCities() 'last edited March 18, 2004 Dim myCell As Range Dim wks As Worksheet Dim DataBaseWks As Worksheet Dim ListRange As Range Dim dummyRng As Range Dim myDatabase As Range Dim TempWks As Worksheet Dim rsp As Integer Dim i As Long 'include bottom most header row Const TopLeftCellOfDataBase As String = "A4" 'what column has your key values Const KeyColumn As String = "A" 'where's your data Set DataBaseWks = Worksheets("Main") i = DataBaseWks.Range(TopLeftCellOfDataBase).Row - 1 rsp = MsgBox("Include headings?", vbYesNo, "Headings") Set TempWks = Worksheets.Add With DataBaseWks Set dummyRng = .UsedRange Set myDatabase = .Range(TopLeftCellOfDataBase, _ .Cells.SpecialCells(xlCellTypeLastCell)) End With 'rebuild the List With DataBaseWks Intersect(myDatabase, .Columns(KeyColumn)).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=TempWks.Range("A1"), _ Unique:=True 'Add the heading to the criteria area TempWks.Range("D1").Value = _ .Cells(.Range(TopLeftCellOfDataBase).Row, KeyColumn).Value End With With TempWks Set ListRange = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp)) End With With ListRange .Sort Key1:=.Cells(1), Order1:=xlAscending, _ Header:=xlNo, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom End With 'check for individual City worksheets For Each myCell In ListRange.Cells If WksExists(myCell.Value) = False Then Set wks = Sheets.Add On Error Resume Next wks.Name = myCell.Value If Err.Number < 0 Then MsgBox "Please rename: " & wks.Name Err.Clear End If On Error GoTo 0 wks.Move After:=Sheets(Sheets.Count) Else Set wks = Worksheets(myCell.Value) wks.Cells.Clear End If If rsp = 6 Then DataBaseWks.Rows("1:" & i).Copy Destination:=wks.Range("A1") End If 'change the criteria in the Criteria range TempWks.Range("D2").Value = "=" & Chr(34) & "=" & myCell.Value & Chr(34) 'transfer data to individual City worksheets If rsp = 6 Then myDatabase.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=TempWks.Range("D1:D2"), _ CopyToRange:=wks.Range("A1").Offset(i, 0), _ Unique:=False Else myDatabase.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=TempWks.Range("D1:D2"), _ CopyToRange:=wks.Range("A1"), _ Unique:=False End If Next myCell Application.DisplayAlerts = False TempWks.Delete Application.DisplayAlerts = True MsgBox "Data has been sent" End Sub Function WksExists(wksName As String) As Boolean On Error Resume Next WksExists = CBool(Len(Worksheets(wksName).Name) 0) End Function -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Please help me edit this code..Thanks in advance :-) | Excel Programming | |||
SELECT THE FIRST CELL IN ADVANCE FILTERed worksheet vba code | Excel Programming | |||
Advance Filter & If Code | Excel Programming | |||
Code to Advance filter a list in a shared workbook | Excel Programming | |||
Code Edit | Excel Programming |