Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
This macro is working wonderfully to populate multiple worksheets based on
the data in the "A-Rad" (ws1) worksheet. Now I would like to add a step where I can delete any worksheets each time this changes. So, in other words, I need to delete a worksheet if the distinct value in ws1.Columns("A:A") < the current worksheet names. Would it be better to delete all Worksheet Names < "A-Rad" and then update the worksheets with this code? I will always need to keep "Set ws1 = Sheets("A-Rad")" since this serves as the main data source. I have tried and struggling with the proper syntax and placement within this code to identify the Worksheet names < "A-Rad" and then delete those. Your help is greatly appreciated. Sub PopulateRadWorksheets() Dim ws1 As Worksheet Dim wsNew As Worksheet Dim rng As Range Dim r As Integer Dim c As Range Set ws1 = Sheets("A-Rad") Set rng = Range("AllRadiologists") Dim N As Integer Dim M As Integer Dim FirstWSToSort As Integer Dim LastWSToSort As Integer Dim SortDescending As Boolean 'extract a list of Radiologists ws1.Columns("A:A").Copy _ Destination:=Range("L1") ws1.Columns("L:L").AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=Range("J1"), Unique:=True r = Cells(Rows.Count, "J").End(xlUp).Row 'set up Criteria Area Range("L1").Value = Range("A1").Value For Each c In Range("J2:J" & r) 'add to the criteria area ws1.Range("L2").Value = c.Value 'add new sheet (if required) 'and run advanced filter If WksExists(c.Value) Then Sheets(c.Value).Cells.Clear rng.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("A-Rad").Range("L1:L2"), _ CopyToRange:=Sheets(c.Value).Range("A1"), _ Unique:=False Columns.AutoFit Else Set wsNew = Sheets.Add wsNew.Move After:=Worksheets(Worksheets.Count) wsNew.Name = c.Value rng.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("A-Rad").Range("L1:L2"), _ CopyToRange:=wsNew.Range("A1"), _ Unique:=False Columns.AutoFit End If Next ws1.Select ws1.Columns("J:L").Delete SortDescending = False If ActiveWindow.SelectedSheets.Count = 1 Then FirstWSToSort = 1 LastWSToSort = Worksheets.Count Else With ActiveWindow.SelectedSheets For N = 2 To .Count If .Item(N - 1).Index < .Item(N).Index - 1 Then MsgBox "You cannot sort non-adjacent sheets" Exit Sub End If Next N FirstWSToSort = .Item(1).Index LastWSToSort = .Item(.Count).Index End With End If For M = FirstWSToSort To LastWSToSort For N = M To LastWSToSort If SortDescending = True Then If UCase(Worksheets(N).Name) UCase(Worksheets(M).Name) Then Worksheets(N).Move Befo=Worksheets(M) End If Else If UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then Worksheets(N).Move Befo=Worksheets(M) End If End If Next N Next M End Sub Function WksExists(wksName As String) As Boolean On Error Resume Next WksExists = CBool(Len(Worksheets(wksName).Name) 0) End Function |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Delete Macro with OR/ELSE condition | Excel Discussion (Misc queries) | |||
Delete Row with condition | Excel Discussion (Misc queries) | |||
Delete a row when a condition is met using VBA | Excel Programming | |||
Can I delete an entire row if condition is not met? | Excel Worksheet Functions | |||
delete rows with certain condition | Excel Programming |