the_crooked_toe
New Member
- Joined
- May 11, 2005
- Messages
- 44
i have tried 2 different ways of sorting my worksheets in alphabetical order. Each time i try these it does something to all the sheets where it's not letting my For statement to run correctly. It was running correctly before I added the Sort Sheets macro.
My workbook has a bunch of sheets for every agent and one summary sheet. The for statement looks in A1 for the condition. the condition is in every sheet except for the summary sheet.
Here is my For statement. Its was looking in A1 for the criteria before and working fine but for some reason it now is finding the criteria in the "summary" sheet when there criteria is not there?!?!
Here are the two seperate alphabetize codes that I've tried
And this is the other one i tried instead.
My workbook has a bunch of sheets for every agent and one summary sheet. The for statement looks in A1 for the condition. the condition is in every sheet except for the summary sheet.
Here is my For statement. Its was looking in A1 for the criteria before and working fine but for some reason it now is finding the criteria in the "summary" sheet when there criteria is not there?!?!
Code:
Sub run_it()
If Range("A8") <> "" Then
Range("A8").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
End If
'********************************************
'Numbered Month to Name
Dim month As Integer
Dim month1 As String
month = InputBox("Enter the MONTH (Number) you are reporting")
If month = 1 Then
month1 = "January"
ElseIf month = 2 Then
month1 = "February"
ElseIf month = 3 Then
month1 = "March"
ElseIf month = 4 Then
month1 = "April"
ElseIf month = 5 Then
month1 = "May"
ElseIf month = 6 Then
month1 = "June"
ElseIf month = 7 Then
month1 = "July"
ElseIf month = 8 Then
month1 = "August"
ElseIf month = 9 Then
month1 = "September"
ElseIf month = 10 Then
month1 = "October"
ElseIf month = 11 Then
month1 = "November"
ElseIf month = 12 Then
month1 = "December"
End If
Range("B4").Value = month1
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Range("A1").Value = "ACSR TREND TRACKER" Then
ws.Activate
Range("B1").Value = "."
Range("C1").Value = "."
employee = ActiveSheet.Name
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=">=" & month & "/1/2006", Operator:=xlAnd, _
Criteria2:="<" & month + 1 & "/1/2006"
Range("E65000").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(109,R[-64999]C:R[-1]C)"
Range("E65000").Select
Selection.AutoFill Destination:=Range("E65000:AZ65000"), Type:=xlFillDefault
Range("E65000").Select
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Cut
Sheets("Summary").Select
Range("A4").End(xlDown).Offset(1, 1).Select
ActiveSheet.Paste
ActiveCell.Offset(0, -1).Value = employee
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
Selection.Copy
ActiveCell.PasteSpecial (xlPasteValues)
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireRow.Insert Shift:=xlDown
ws.Activate
Range("A1").Select
Selection.AutoFilter
End If
Next ws
Dim i, j As Integer
Sheets("Summary").Select
Range("A7").Select
i = 0
j = 1
Do Until i = 45
If ActiveCell = "" Then
ActiveCell.EntireColumn.Delete
ActiveCell.Offset(0, -1).Select
End If
i = i + 1
ActiveCell.Offset(0, 1).Select
Loop
Range("A8").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = False
End Sub
Here are the two seperate alphabetize codes that I've tried
Code:
Sub new_agent()
Dim agentname As String
agentname = InputBox("What is the agent's name? ie. Smith, John", "New Agent Tab")
Sheets("Agent Template").Visible = True
Sheets.Add
ActiveSheet.Name = agentname
Sheets("Agent Template").Select
Range("A1:AZ1000").Select
Selection.Copy
Sheets(agentname).Select
Range("A1").Select
ActiveSheet.Paste
Rows("1:1").RowHeight = 240.75
Columns("A:A").EntireColumn.AutoFit
Cells.Select
Cells.EntireColumn.AutoFit
ActiveWindow.Zoom = 85
ActiveWindow.Zoom = 70
Cells.EntireColumn.AutoFit
Columns("B:B").Select
Selection.ColumnWidth = 19.57
Selection.ColumnWidth = 16.86
Columns("C:C").ColumnWidth = 14.14
Range("A1").Select
Sheets("Agent Template").Visible = False
Sheets("Summary").Select
Call AlphaSortSheets
Sheets("Summary").Move before:=Sheets(1)
Sheets(agentname).Select
End Sub
Sub AlphaSortSheets()
' This routine sorts the sheets of the
' active workbook in ascending order.
Dim SheetNames() As String
Dim i As Integer
Dim SheetCount As Integer
Dim VisibleWins As Integer
Dim Item As Object
Dim OldActive As Object
On Error Resume Next
SheetCount = ActiveWorkbook.Sheets.Count
If Err <> 0 Then Exit Sub ' No active workbook
' Check for protected workbook structure
If ActiveWorkbook.ProtectStructure Then
MsgBox ActiveWorkbook.Name & " is protected.", _
vbCritical, "Cannot Sort Sheets."
Exit Sub
End If
' Disable Ctrl+Break
Application.EnableCancelKey = xlDisabled
' Get the number of sheets
SheetCount = ActiveWorkbook.Sheets.Count
' Redimension the array
ReDim SheetNames(1 To SheetCount)
' Store a reference to the active sheet
Set OldActive = ActiveSheet
' Fill array with sheet names and hidden status
For i = 1 To SheetCount
SheetNames(i) = ActiveWorkbook.Sheets(i).Name
Next i
' Sort the array in ascending order
Call BubbleSort(SheetNames)
' Turn off screen updating
Application.ScreenUpdating = False
' Move the sheets
For i = 1 To SheetCount
ActiveWorkbook.Sheets(SheetNames(i)).Move _
ActiveWorkbook.Sheets(i)
Next i
' Reactivate the original active sheet
OldActive.Activate
End Sub
Sub BubbleSort(List() As String)
' Sorts the List array in ascending order
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp
First = LBound(List)
Last = UBound(List)
For i = First To Last - 1
For j = i + 1 To Last
If List(i) > List(j) Then
Temp = List(j)
List(j) = List(i)
List(i) = Temp
End If
Next j
Next i
End Sub
And this is the other one i tried instead.
Code:
Sub SortSheets()
Dim sCount As Integer, i As Integer, j As Integer
With Application
.Calculation = xlCalculationManual
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
sCount = Worksheets.Count
If sCount = 1 Then Exit Sub
For i = 1 To sCount - 1
For j = i + 1 To sCount
If Worksheets(j).Name < Worksheets(i).Name Then
Worksheets(j).Move Before:=Worksheets(i)
End If
Next j
Next i
With Application
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub