Combining 2 Marco to Run all at once

GCLIFTON

Board Regular
Joined
Feb 11, 2016
Messages
60
How do i combine the 2 Macro to run all at once. Below is the last part of the 1st Marco then the beginning of the second. Should i just add After Next End IF Layering End Sub

For i = 1 TorepRng.Count
cpyRng.Offset(cpyRng.Rows.Count * i) =cpyRng.Value
cpyRng.Columns(1).Offset(cpyRng.Rows.Count* i, cpyRng.Columns.Count) = repRng(i)
Next
End Sub


Sub Layering()
Application.ScreenUpdating = False
Dim ws1 As Worksheet
Set ws1 = ActiveSheet
Dim bottomA As Long
bottomA = ws1.Range("A"& Rows.Count).End(xlUp).Row
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
How do i combine the 2 Macro to run all at once. Below is the last part of the 1st Marco then the beginning of the second. Should i just add After Next End IF Layering End Sub

For i = 1 TorepRng.Count
cpyRng.Offset(cpyRng.Rows.Count * i) =cpyRng.Value
cpyRng.Columns(1).Offset(cpyRng.Rows.Count* i, cpyRng.Columns.Count) = repRng(i)
Next
End Sub


Sub Layering()
Application.ScreenUpdating = False
Dim ws1 As Worksheet
Set ws1 = ActiveSheet
Dim bottomA As Long
bottomA = ws1.Range("A"& Rows.Count).End(xlUp).Row
Hi GCLIFTON,

Without seeing the full code for both macros it is hard to tell what exactly you are trying to do and what you will achieve by combining the 2 together.

If you want the first macro to have completed its loop before the layering part is processed you could just put this before the End Sub line in the first macro:

Rich (BB code):
For i = 1 TorepRng.Count
cpyRng.Offset(cpyRng.Rows.Count * i) =cpyRng.Value
cpyRng.Columns(1).Offset(cpyRng.Rows.Count* i, cpyRng.Columns.Count) = repRng(i)
Next
Call Layering
End Sub

Alternatively it may be possible to include it all in a single macro, but again it will very much depend on what the rest of the 2 macros are doing and we wont know that without seeing them both in full.

If you are able to share the full macros, please remember to put them inside
Code:
 tags...

[ CODE ] Your macro goes here [ /CODE ]

Like that, but without the spaces inside the square brackets.
 
Last edited:
Upvote 0
Below is the Full Macro. Also in the Layering Macro are you able to tell me how i can have the tabs to create from Column P beside Column A




Sub Copy()
Dim cpyRng As Range
Dim repRng As Range
Dim i As Long




Set cpyRng = Sheets("Sheet1").Range("A1:T189")
Set repRng = Sheets("Sheet2").Range("A:A").CurrentRegion




For i = 1 To repRng.Count
cpyRng.Offset(cpyRng.Rows.Count * i) = cpyRng.Value
cpyRng.Columns(1).Offset(cpyRng.Rows.Count * i, cpyRng.Columns.Count - 5) = repRng(i)
Next


End Sub
Sub Tab_()


Application.ScreenUpdating = False
Dim ws1 As Worksheet
Set ws1 = ActiveSheet
Dim bottomA As Long
bottomA = ws1.Range("A" & Rows.Count).End(xlUp).Row
Dim c As Range
Dim rng As Range
Dim ws As Worksheet
ws1.Range("A1:A" & bottomA).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
("A1:A" & bottomA), Unique:=True
Set rngUniques = ws1.Range("A2:A" & bottomA).SpecialCells(xlCellTypeVisible)
If ws1.FilterMode Then ws1.ShowAllData
For Each c In rngUniques
Set ws = Nothing
On Error Resume Next
Set ws = Worksheets(CStr(c.Value))
On Error GoTo 0
If ws Is Nothing Then
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = CStr(c.Value)
ws1.Rows(1).EntireRow.Copy ActiveSheet.Cells(1, 1)
End If
Next c
For Each rng In rngUniques
Sheets(CStr(rng)).UsedRange.Offset(1, 0).ClearContents
ws1.Range("A1:I" & bottomA).AutoFilter Field:=1, Criteria1:=rng
ws1.Range("A2:I" & bottomA).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(CStr(rng)).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
If ws1.FilterMode Then ws1.ShowAllData
Next rng
ws1.Activate
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Sorry i sent this incorrectly. Is this how it should look? If yes, here is my original question from your reply Below is the Full Macro. Also in the Layering Macro are you able to tell me how i can have the tabs to create from Column P beside Column A or any other Column. But for this one Column P


Code:
[COLOR=#574123]Dim cpyRng As Range[/COLOR]
[COLOR=#574123]Dim repRng As Range[/COLOR]
[COLOR=#574123]Dim i As Long[/COLOR]
[COLOR=#574123]Set cpyRng = Sheets("Sheet1").Range("A1:T189")[/COLOR]
[COLOR=#574123]Set repRng = Sheets("Sheet2").Range("A:A").CurrentRegion[/COLOR]
[COLOR=#574123]For i = 1 To repRng.Count[/COLOR]
[COLOR=#574123]cpyRng.Offset(cpyRng.Rows.Count * i) = cpyRng.Value[/COLOR]
[COLOR=#574123]cpyRng.Columns(1).Offset(cpyRng.Rows.Count * i, cpyRng.Columns.Count - 5) = repRng(i)[/COLOR]
[COLOR=#574123]Next[/COLOR]
[COLOR=#574123]End Sub

[CODE2]
[/COLOR][COLOR=#574123]Sub Tab_()[/COLOR]


[COLOR=#574123]Application.ScreenUpdating = False[/COLOR]
[COLOR=#574123]Dim ws1 As Worksheet[/COLOR]
[COLOR=#574123]Set ws1 = ActiveSheet[/COLOR]
[COLOR=#574123]Dim bottomA As Long[/COLOR]
[COLOR=#574123]bottomA = ws1.Range("A" & Rows.Count).End(xlUp).Row[/COLOR]
[COLOR=#574123]Dim c As Range[/COLOR]
[COLOR=#574123]Dim rng As Range[/COLOR]
[COLOR=#574123]Dim ws As Worksheet[/COLOR]
[COLOR=#574123]ws1.Range("A1:A" & bottomA).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _[/COLOR]
[COLOR=#574123]("A1:A" & bottomA), Unique:=True[/COLOR]
[COLOR=#574123]Set rngUniques = ws1.Range("A2:A" & bottomA).SpecialCells(xlCellTypeVisible)[/COLOR]
[COLOR=#574123]If ws1.FilterMode Then ws1.ShowAllData[/COLOR]
[COLOR=#574123]For Each c In rngUniques[/COLOR]
[COLOR=#574123]Set ws = Nothing[/COLOR]
[COLOR=#574123]On Error Resume Next[/COLOR]
[COLOR=#574123]Set ws = Worksheets(CStr(c.Value))[/COLOR]
[COLOR=#574123]On Error GoTo 0[/COLOR]
[COLOR=#574123]If ws Is Nothing Then[/COLOR]
[COLOR=#574123]Worksheets.Add(After:=Sheets(Sheets.Count)).Name = CStr(c.Value)[/COLOR]
[COLOR=#574123]ws1.Rows(1).EntireRow.Copy ActiveSheet.Cells(1, 1)[/COLOR]
[COLOR=#574123]End If[/COLOR]
[COLOR=#574123]Next c[/COLOR]
[COLOR=#574123]For Each rng In rngUniques[/COLOR]
[COLOR=#574123]Sheets(CStr(rng)).UsedRange.Offset(1, 0).ClearContents[/COLOR]
[COLOR=#574123]ws1.Range("A1:I" & bottomA).AutoFilter Field:=1, Criteria1:=rng[/COLOR]
[COLOR=#574123]ws1.Range("A2:I" & bottomA).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(CStr(rng)).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)[/COLOR]
[COLOR=#574123]If ws1.FilterMode Then ws1.ShowAllData[/COLOR]
[COLOR=#574123]Next rng[/COLOR]
[COLOR=#574123]ws1.Activate[/COLOR]
[COLOR=#574123]Application.ScreenUpdating = True[/COLOR]
[COLOR=#574123]End Sub[/COLOR]
 
Upvote 0
You still have not quite got the hang of the code tags :)

[ CODE ] <-- first "open" code tag (without the spaces)
Code:
[COLOR=#574123]Dim cpyRng As Range[/COLOR]
[COLOR=#574123]Dim repRng As Range[/COLOR]
[COLOR=#574123]Dim i As Long[/COLOR]
[COLOR=#574123]Set cpyRng = Sheets("Sheet1").Range("A1:T189")[/COLOR]
[COLOR=#574123]Set repRng = Sheets("Sheet2").Range("A:A").CurrentRegion[/COLOR]
[COLOR=#574123]For i = 1 To repRng.Count[/COLOR]
[COLOR=#574123]cpyRng.Offset(cpyRng.Rows.Count * i) = cpyRng.Value[/COLOR]
[COLOR=#574123]cpyRng.Columns(1).Offset(cpyRng.Rows.Count * i, cpyRng.Columns.Count - 5) = repRng(i)[/COLOR]
[COLOR=#574123]Next[/COLOR]
[COLOR=#574123]End Sub
[/COLOR]

[ /CODE ] <-- first "close" code tag (again without the spaces)

Next we will put your second macro inside its own code tags

[ CODE ] <-- second "open" code tag
Code:
[COLOR=#574123]Sub Tab_()[/COLOR]
[COLOR=#574123]Application.ScreenUpdating = False[/COLOR]
[COLOR=#574123]Dim ws1 As Worksheet[/COLOR]
[COLOR=#574123]Set ws1 = ActiveSheet[/COLOR]
[COLOR=#574123]Dim bottomA As Long[/COLOR]
[COLOR=#574123]bottomA = ws1.Range("A" & Rows.Count).End(xlUp).Row[/COLOR]
[COLOR=#574123]Dim c As Range[/COLOR]
[COLOR=#574123]Dim rng As Range[/COLOR]
[COLOR=#574123]Dim ws As Worksheet[/COLOR]
[COLOR=#574123]ws1.Range("A1:A" & bottomA).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _[/COLOR]
[COLOR=#574123]("A1:A" & bottomA), Unique:=True[/COLOR]
[COLOR=#574123]Set rngUniques = ws1.Range("A2:A" & bottomA).SpecialCells(xlCellTypeVisible)[/COLOR]
[COLOR=#574123]If ws1.FilterMode Then ws1.ShowAllData[/COLOR]
[COLOR=#574123]For Each c In rngUniques[/COLOR]
[COLOR=#574123]Set ws = Nothing[/COLOR]
[COLOR=#574123]On Error Resume Next[/COLOR]
[COLOR=#574123]Set ws = Worksheets(CStr(c.Value))[/COLOR]
[COLOR=#574123]On Error GoTo 0[/COLOR]
[COLOR=#574123]If ws Is Nothing Then[/COLOR]
[COLOR=#574123]Worksheets.Add(After:=Sheets(Sheets.Count)).Name = CStr(c.Value)[/COLOR]
[COLOR=#574123]ws1.Rows(1).EntireRow.Copy ActiveSheet.Cells(1, 1)[/COLOR]
[COLOR=#574123]End If[/COLOR]
[COLOR=#574123]Next c[/COLOR]
[COLOR=#574123]For Each rng In rngUniques[/COLOR]
[COLOR=#574123]Sheets(CStr(rng)).UsedRange.Offset(1, 0).ClearContents[/COLOR]
[COLOR=#574123]ws1.Range("A1:I" & bottomA).AutoFilter Field:=1, Criteria1:=rng[/COLOR]
[COLOR=#574123]ws1.Range("A2:I" & bottomA).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(CStr(rng)).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)[/COLOR]
[COLOR=#574123]If ws1.FilterMode Then ws1.ShowAllData[/COLOR]
[COLOR=#574123]Next rng[/COLOR]
[COLOR=#574123]ws1.Activate[/COLOR]
[COLOR=#574123]Application.ScreenUpdating = True[/COLOR]
[COLOR=#574123]End Sub
[/COLOR]

[ /CODE ] <-- second "close" code tag

Are you able to explain to us in words what these macros are supposed to be doing?
 
Last edited:
Upvote 0
The first Macro

1. Is labeling copied data from a list of Unit Numbers located in Sheet 2. (Question: Is there a way for that Macro to not copy the Header row over and over. Just the data that starts in A2: T189?)
2. Second Macro is taking what was copied in Sheet 1 over and over and it is currently now looking in A1 to first i believe Sort by A1 and create tabs for each with the Copied data. I now would like for that Macro to look in Column P. beside A to do that function. Can you help me with that as well.

It would be nice if all of this was in one Macro.
 
Upvote 0

Forum statistics

Threads
1,213,561
Messages
6,114,312
Members
448,564
Latest member
ED38

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
Back
Top