When I Use my "SortSheets" Macro my For statement

[the_crooked_toe]

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?!?!

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

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.

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

 

[Cbrine]

Here's some code that uses Excel sort feature, instead of creating your own. Just add a worksheet before all the others, and add a button with this code. The code will only work if the worksheet with the button is the first worksheet.

HTH
Cal

Private Sub CommandButton1_Click()
Dim wb As Workbook, ws As Worksheet, cs As Worksheet, cell As Range
Set wb = ActiveWorkbook
Set ws = ActiveSheet

For Each cs In wb.Sheets
    If cs.Name <> ws.Name Then
        ws.Range("A65535").End(xlUp).Offset(1, 0).Value = cs.Name
    End If
Next cs
ws.Range("A1", ws.Range("A65535").End(xlUp)).Sort ws.Range("A2"), xlDescending

For Each cell In ws.Range("A2", ws.Range("A65535").End(xlUp))
    wb.Sheets(cell.Value).Move , Sheets(1)
Next cell

ws.Range("A1", ws.Range("A65535").End(xlUp)).ClearContents
ws.Activate
End Sub

 

[the_crooked_toe]

tah sort the sheets correctly but it's still changing some property on the "summary" page and running the For statement on it. Even though the summary page does not contain the For statement criteria

 

[Norie]

The problem with your For Next is probably because you don't actually use the worksheet reference ws within it.

By doing that every time you refer to a range VBA will use the active sheet.

I know you have ws.Activate but it would be much better to explicitly reference ws in the code.

For Each ws In Worksheets
    If ws.Range("A1").Value = "ACSR TREND TRACKER" Then
        With ws
            .Range("B1").Value = "."
            .Range("C1").Value = "."
            employee = ws.Name
            .Range("A1").AutoFilter
            .Range("A1").AutoFilter Field:=1, Criteria1:=">=" & Month & "/1/2006", Operator:=xlAnd, _
        Criteria2:="<" & Month + 1 & "/1/2006"
            .Range("E65000").FormulaR1C1 = "=SUBTOTAL(109,R[-64999]C:R[-1]C)"
            .Range("E65000").AutoFill Destination:=.Range("E65000:AZ65000"), Type:=xlFillDefault
        End With
    End If
Next ws

 

[Cbrine]

Can you post the piece of code that is running when it shouldn't be?

I think it might be this?

If ws.Range("A1").Value = "ACSR TREND TRACKER" Then

Should work, it's looking at each sheets A1 value for "ACSR TREND TRACKER" in order to execute the conditional statement.

Cal

 

[the_crooked_toe]

CBrine, it is messing up right here. I know that A1 is the criteria. The summary page does not have that in Cell A1.

Norie. I do not know much about explicitly using the code. how do i finish up writing the rest to make it copy that row back on to the summary page. thanks!

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

 

[Norie]

The reason I didn't rewrite the rest of the code is because I was unsure exactly what you were doing.

That's one of the problems when you don't reference worksheets - it's hard to work out what the code is doing.

 

[the_crooked_toe]

after is autofills the distination

.

Selection.AutoFill Destination:=Range("E65000:AZ65000"), Type:=xlFillDefault

I want to cut the destination and paste it on the summary sheet. and then turn off autofilter on the ws sheet

 

[the_crooked_toe]

hey norie i think i figured it out. Thanks again for all your help. now i just gotta figure out how to NOT make it grab data from the template page.

For Each ws In Worksheets
    If ws.Range("A1").Value = "ACSR TREND TRACKER" Then
        With ws
            .Range("B1").Value = "."
            .Range("C1").Value = "."
             employee = ws.Name
            .Range("A1").AutoFilter
            .Range("A1").AutoFilter Field:=1, Criteria1:=">=" & month & "/1/2006", Operator:=xlAnd, _
        Criteria2:="<" & month + 1 & "/1/2006"
            .Range("E65000").FormulaR1C1 = "=SUBTOTAL(109,R[-64999]C:R[-1]C)"
            .Range("E65000").AutoFill Destination:=.Range("E65000:AZ65000"), Type:=xlFillDefault
            .Application.CutCopyMode = False
            .Range("E65000:AZ65000").Cut
          ' .Range("E65000").Select

           ' .Range(ActiveCell, ActiveCell.End(xlToRight)).Cut
            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
        End With
        With ws
            .Range("A1").AutoFilter
        End With
    End If
Next ws