Combining Macros

Emily_SERT

New Member
Joined
Sep 17, 2009
Messages
11
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:
Code:
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:
Code:
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.
 
Last edited:

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

njimack

Well-known Member
Joined
Jun 17, 2005
Messages
7,764
Not sure why the copy/paste wouldn't work, but that code could be condensed...

This code
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
Code:
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

Well-known Member
Joined
Apr 28, 2004
Messages
76,218
Office Version
  1. 365
Platform
  1. Windows
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.:)
Code:
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

Board Regular
Joined
Sep 4, 2009
Messages
190
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

Code:
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

Board Regular
Joined
Sep 4, 2009
Messages
190

ADVERTISEMENT

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

Code:
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

New Member
Joined
Sep 17, 2009
Messages
11
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

Well-known Member
Joined
Apr 28, 2004
Messages
76,218
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

New Member
Joined
Sep 17, 2009
Messages
11
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

Board Regular
Joined
Sep 4, 2009
Messages
190
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.:oops: This was a time i was glad i had autosave turned on (I normaly have it turned off):pray:

Glad its all working

Mike
 

Watch MrExcel Video

Forum statistics

Threads
1,122,496
Messages
5,596,502
Members
414,073
Latest member
Contilly

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top