Combining Macros

[Emily_SERT]

I have three macros that I'm attempting to combine to run as one in Excel 2007 (1-copy and paste cells to several worksheets, 2-sort several worksheets simultaneously, 3-sort the summary worksheet). Per other posts I created a "main" macro and "call"ed the other macros in. The main macro runs through, but the copy and paste macro does not seem to actually work within the combined macro (all work seperately).

This is the code I used:

Sub main()
Call Fill_Names
Call DynaSort_Assign
Call Sort_TimeSummary
End Sub

When that didn't work, I also tried using the full code from each of the macros:

Sub main()
Call Fill_Names
Sheets("Time Summary").Select
Range("A8:B308").Select
Selection.Copy
Sheets("Time-Week 1").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 2").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 3").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 4").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 5").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 6").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time Summary").Select
Range("A8").Select
Call DynaSort_Assign
Dim wsSheet As Worksheet
Dim v As Range
Dim findRow As Integer
Dim c As Range
For Each wsSheet In Worksheets
Select Case wsSheet.CodeName
Case "Sheet9", "Sheet17", "Sheet18", "Sheet19", "Sheet20", "Sheet21"
Set FindRng = wsSheet.Range("A8:AD8" & wsSheet.Range("A65536").End(xlUp).Row)
With FindRng
Set c = .Find(What:="", After:=FindRng.Cells(1, 1), LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not c Is Nothing Then
findRow = c.Row - 1
Else
findRow = FindRng.Rows.Count + 7
End If
End With
With wsSheet.Range("A8:AD8" & findRow)
.Sort Key1:=.Range("A8"), Order1:=xlAscending, _
Key2:=.Range("B8"), Order2:=xlAscending, Header:=xlNo
End With
Case Else
'Nothing
End Select
Next wsSheet
Call Sort_TimeSummary
Range("A8:B308").Select
ActiveWorkbook.Worksheets("Time Summary").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Time Summary").Sort.SortFields.Add Key:=Range("A8" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Time Summary").Sort
.SetRange Range("A8:B308")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

I would appreciate any help you can provide.

 

[njimack]

Not sure why the copy/paste wouldn't work, but that code could be condensed...

This code

Sheets("Time Summary").Select
Range("A8:B308").Select
Selection.Copy
Sheets("Time-Week 1").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 2").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 3").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 4").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 5").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 6").Select
Range("A8").Select
ActiveSheet.Paste

could be reduced to

Dim i As Long

Sheets("Time Summary").Range("A8:B308").Copy

For i = 1 to 6

Sheets("Time-Week " & i).Range("A8").Paste

Next

 

[Norie]

Emily

The first thing you should do is lose all that use of Select, then you should make sure you are referencing things properly.

It also might help if you explained in words what the code is meant to do, and little indentation never did anybody any harm.

Sub main()
Dim wsSheet As Worksheet
Dim v As Range
Dim findRow As Long
Dim c As Range
Dim I As Long
    Call Fill_Names
    For I = 1 To 6
        Sheets("Time Summary").Range("A8:B308").Copy Sheets("Time-Week " & I).Range("A8")
    Next I
    Call DynaSort_Assign
    For Each wsSheet In Worksheets
        Select Case wsSheet.CodeName
            Case "Sheet9", "Sheet17", "Sheet18", "Sheet19", "Sheet20", "Sheet21"
                Set FindRng = wsSheet.Range("A8:AD8" & wsSheet.Range("A65536").End(xlUp).Row)
                With FindRng
                    Set c = .Find(What:="", After:=FindRng.Cells(1, 1), LookIn:=xlValues, LookAt _
                                                                                          :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                    If Not c Is Nothing Then
                        findRow = c.Row - 1
                    Else
                        findRow = FindRng.Rows.Count + 7
                    End If
                End With
                With wsSheet.Range("A8:AD8" & findRow)
                    .Sort Key1:=.Range("A8"), Order1:=xlAscending, _
                          Key2:=.Range("B8"), Order2:=xlAscending, Header:=xlNo
                End With
            Case Else
                'Nothing
        End Select
    Next wsSheet
    Call Sort_TimeSummary
    
    With Worksheets("Time Summary")
    
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("A8"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        
        With .Sort
            .SetRange Range("A8:B308")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
    End With
    
End Sub

 

[CMIIandExcel]

The code below handles the copy and paste section, it might be able to be trimed down a bit by others but it works fine

Regards

Option Explicit
Option Compare Text

Sub Main()

Fill_Names
DynaSort_Assign
Sort_TimeSummary

End Sub
Sub Fill_Names()
  Dim wsShIn As Worksheet
  Dim wsShOut As Worksheet
  Dim strSheetName As String
  Dim iSheetCount As Long
  
  Set wsShIn = Worksheets("Time Summary")
  wsShIn.Range("a8:b308").Copy
  For iSheetCount = 1 To 6
    strSheetName = "Time-Week " & iSheetCount
    Set wsShOut = Worksheets(strSheetName)
    wsShOut.Activate
    wsShOut.Cells(8, 1).PasteSpecial xlPasteAll
  Next iSheetCount
End Sub
Sub DynaSort_Assign()

End Sub
Sub Sort_TimeSummary()
 
End Sub

 

[CMIIandExcel]

Out of intrest, and in the intrest of making life simple, You said the code worked fine when it was split into its 3 parts?

If yes try just copying the code below putting it into a copy of the workbook and running it.

Note the one caveat half way down the code as it may not be on the right sheet

Regards
Mike

Sub main()
Dim wsSheet As Worksheet
Dim v As Range
Dim findRow As Integer
Dim c As Range



Sheets("Time Summary").Select
Range("A8:B308").Select
Selection.Copy
Sheets("Time-Week 1").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 2").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 3").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 4").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 5").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time-Week 6").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Time Summary").Select
Range("A8").Select


For Each wsSheet In Worksheets
Select Case wsSheet.CodeName
Case "Sheet9", "Sheet17", "Sheet18", "Sheet19", "Sheet20", "Sheet21"
Set FindRng = wsSheet.Range("A8:AD8" & wsSheet.Range("A65536").End(xlUp).Row)
With FindRng
Set c = .Find(What:="", After:=FindRng.Cells(1, 1), LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not c Is Nothing Then
findRow = c.Row - 1
Else
findRow = FindRng.Rows.Count + 7
End If
End With
With wsSheet.Range("A8:AD8" & findRow)
.Sort Key1:=.Range("A8"), Order1:=xlAscending, _
Key2:=.Range("B8"), Order2:=xlAscending, Header:=xlNo
End With
Case Else
'Nothing
End Select
Next wsSheet


'@@@ You may need to activate the correct worksheet here before you select the range@@@


Range("A8:B308").Select
ActiveWorkbook.Worksheets("Time Summary").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Time Summary").Sort.SortFields.Add Key:=Range("A8" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Time Summary").Sort
.SetRange Range("A8:B308")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
end sub

 

[Emily_SERT]

You all are certainly very fast and helpful. I really appreciate the response. Unfortunately, the code changes don't seem to make a difference.

The condensed first "copy/paste" macro from njimack, resulted in a "Run-Time error'438': Object doesn't support this property or method." That may be my fault, as I simply deleted the old macro and pasted this, no correction or changes (too novice for that).

The second correction from Norie ran but did not seem to run the DynaSort macro. Basically what I have is a workbook with multiple pages for time entry (1 for each week in a month). So that names only have to be entered once a month, the first macro is to fill the names entered on the Time Summary sheet to each weekly time entry page (Time-Week 1, etc). The second macro is to sort all the time entry pages simultaneously so they are in alphabetical order by last name, the names begin at cell A:8. Since the Time-Summary results are driven by the other pages, the formulas get mixed up if the same dynasort is run on this page--the last macro sorts only the names on this sheet, still A:8. I hope that clarifies the intent slightly. Also, I REALLY appreciate you reading through that terrible copy/paste, I tried editing it but after 10 minutes the system disallows all edits.

And lastly, Mike's code also ran and the copy/paste macro (first) and the sort summary macro (last) worked, but the dyna sort did not.

Thank you again, I hope you all stick with me.

 

[Norie]

When you say it didn't seem to run the DynaSort macro what do you mean?

If like the code you've posted there are a lot of unqualified references that could cause that to appear happening.

ie the code is running but not on the worksheets/ranges you expect or doing what you expect it to do.

 

[Emily_SERT]

Norie-you are a genius. I feel quite stupid, but the dynasort was acting on the wrong sheets. I've fixed the problem and both yours and Mike's codes run perfectly. Thank you for your effort!

 

[CMIIandExcel]

Emily

Glad to see you got it fixed, i was just reading through the code to try and spot where it was picking up on the wrong sheet.

Note my comment on the recyle of your orignal code as to being unsure what worksheet you would be focused on.

Everyone has thier own style on code and as long as it works right it is correct, there are obviously some things you can to make your life easier when debugging etc.

As Norie said unqualified referencing is defiently one of them.

Activeworkbook/sheet is a term i try not to use, i learnt the hard way of running an unsaved piece of code which automaticly closed workbooks ignoring changes. Whilst debugging i altered the code on the fly and ended up shutting the workbook i had the code in. This was a time i was glad i had autosave turned on (I normaly have it turned off)ray:

Glad its all working

Mike