VBA EXCEL Sorting various sheets same workbook

    Private Sub Worksheet_Calculate()
Dim Xrg As Range
Set Xrg = Worksheets("Monday").Range("F4:F50")
If Not Intersect(Xrg, Worksheets("Monday").Range("F4:F50")) Is Nothing 
Then
Application.Run "DriverSchedule.xlsm!Sort1"
End If
Set Xrg = Nothing
End Sub

I am checking for any change to the F column on sheet1″Monday” if a change happens than I sort using this code: Sub Sort1()

Range("N3:O50").Select
Selection.ClearContents
Range("E3:F50").Select
Selection.Copy
Range("N3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Monday").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Monday").Sort.SortFields.Add Key:=Range("O4:O50") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Monday").Sort
.SetRange Range("N3:O50")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A4").Select
End Sub

This code is located in Module1 and sorts perfectly until I add the next sheets code

    Private Sub Worksheet_Calculate()
Dim Xrg As Range
Set Xrg = Worksheets("Tuesday").Range("F4:F50")
If Not Intersect(Xrg, Worksheets("Tuesday").Range("F4:F50")) Is Nothing 
Then
Application.Run "DriverSchedule.xlsm!Sort2"
End If
Set Xrg = Nothing
End Sub

Now this code is suppose to be looking for a change to column F of sheet2″Tuesday” than if there is a change it calls Module2″sort2″

    Sub Sort2()
Range("N3:O50").Select
Selection.ClearContents
Range("E3:F50").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-18
Range("N3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Tuesday").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tuesday").Sort.SortFields.Add Key:=Range("O4:O50") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tuesday").Sort
.SetRange Range("N3:O50")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A4").Select
End Sub

Which than sorts sheet2″Tuesday” column F and works fine also.

Now the problem is that sheet1″Monday” no longer sorts. I have six sheets to represent Monday through Saturday and I need to sort if there is a change detected in column F but I cant seem to get all the sheets to sort if I add code under the sheet windows and even if I make separate modules for each sheet.

I need to detect a change in column F on whatever day(sheet) I am working on than copy and sort two columns(Columns E and F) to another location on that same sheet.

Any ideas?

Top Contributor Asked on November 20, 2017 in Excel: General.
Add Comment
1 Answer(s)

Macro Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) paste in ThisWorkbook module:

         Option Explicit
         Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const adrs As String = "A4:B50"

Select Case Sh.Name
Case "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"
If Not Intersect(Target, Worksheets(Sh.Name).Range(adrs)) Is Nothing Then
Call Sort(Sh.Name)
End If
Case Else
End Select
End Sub

Macro Sub Sort(shtNme As String) paste in Module1 module


        Option
Explicit

        Sub Sort(shtNme As String)
        On Error GoTo the_end
          Application
.EnableEvents = False

            With ActiveWorkbook.Worksheets(shtNme)
              .Range("N3:O50").ClearContents
              .Range("E3:F50").Copy Destination:=Range("N3")

            With .Sort
              .SortFields.Clear
              .SortFields.Add Key:=Range("O4:O50"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
              .SetRange Range("N3:O50")
              .Header = xlYes
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
           End With

              .Range("A4").Select
           End With

       the_end: Application.EnableEvents = True
     End Sub

Top Contributor Answered on November 27, 2017.
Add Comment
  • Found this useful?

    Please share using the share button above.

    If you found the answer is best answer for your question, Please mark as 'best answer' by clicking on the right tick mark icon at the left side of the answer.

    Found the answer useful and wants to credit the user, then vote the answer (vote up).

  • Your Answer

    By posting your answer, you agree to the privacy policy and terms of service.