LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 70
Default Delete Worksheet Condition

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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Delete Macro with OR/ELSE condition Mike Excel Discussion (Misc queries) 5 January 11th 10 09:08 PM
Delete Row with condition puiuluipui Excel Discussion (Misc queries) 4 June 12th 09 01:49 PM
Delete a row when a condition is met using VBA SBoostrom Excel Programming 8 September 29th 06 11:08 PM
Can I delete an entire row if condition is not met? Christine Excel Worksheet Functions 8 May 4th 06 09:47 AM
delete rows with certain condition Grey Excel Programming 2 December 19th 03 12:05 PM


All times are GMT +1. The time now is 05:27 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"