Thread: How do you put a macro in a macro

Hi drmix
Please see my last two posts.

Option Explicit
Sub Macro1()
'
' Macro1 Macro
'
    Dim r As Long
 
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    On Error Resume Next
    Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]=R1C2,RC[-1],IF(RC[-2]=R3C2,RC[-1],0))"
    Range("D1").Select
    Selection.AutoFill Destination:=Range("D1:D44160")
    Range("D1:D44160").Select
    Selection.Copy
    Columns("C:C").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("D:D").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
 
 
 
 
 
 
    For r = Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1
    If Cells(r, 3) = "0" Then Rows(r).Delete
    Next r
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    End With
    Dim rng1 As Variant, rng2 As Variant, totalRng As Variant, cell As Variant
    Set rng1 = Worksheets("Sheet2").Range("B1")
    Set rng2 = rng1.End(xlDown)
    Set totalRng = Range(rng1, rng2)
    For Each cell In totalRng
    If cell.Value = cell.Offset(1, 0).Value Then
        cell.Rows.EntireRow.Delete Shift:=xlUp
    End If
    Next cell
    Dim rng1 As Variant, rng2 As Variant, totalRng As Variant, cell As Variant
    Set rng1 = Worksheets("Sheet2").Range("B1")
    Set rng2 = rng1.End(xlDown)
    Set totalRng = Range(rng1, rng2)
    For Each cell In totalRng
    If cell.Value = cell.Offset(1, 0).Value Then
        cell.Rows.EntireRow.Delete Shift:=xlUp
    End If
    Next cell
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "=(RC[-1]-R[1]C[-1])/R[1]C[-1]"
    Range("D1:D2").Select
    Selection.AutoFill Destination:=Range("D1:D27632")
    Range("D1:D27632").Select
    Selection.Copy
    Columns("D:D").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("B:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
 
 
 
 
 
 
    For r = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    If Cells(r, 1) = "" Then Rows(r).Delete
    Next r
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    End With
    Columns("B:B").Select
    Selection.Style = "Percent"
    Columns("A:B").Select
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range( _
        "B1:B56142"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange Range("A1:B56142")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Notice the gaps in your code. You had this line "Dim r as Long" multiple times; the gaps indicate where I've removed the line. I've moved it to the top (this is personal preference). Having multiple Dim statements for the same variable will cause this error

Compile error: Duplicate declaration in current scope

You can declare a variable (r) only once in a procedure.

I'm on Grandpa duty for the next several days so, if you have additional issues, I may not be able to respond promptly.

John

Thankyou all! =]

Hi drmix

I looked at you file and you also had these variables declared more than once

Dim rng1 As Variant, rng2 As Variant, totalRng As Variant, cell As Variant

I've no idea what your attempting to do but this code runs on your workbook

Option Explicit
Sub Macro1()
'
' Macro1 Macro
'
    Dim r As Long
    Dim rng1 As Variant, rng2 As Variant, totalRng As Variant, cell As Variant
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    On Error Resume Next
    Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]=R1C2,RC[-1],IF(RC[-2]=R3C2,RC[-1],0))"
    Range("D1").Select
    Selection.AutoFill Destination:=Range("D1:D44160")
    Range("D1:D44160").Select
    Selection.Copy
    Columns("C:C").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Columns("D:D").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
 
 
 
        For r = Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1
            If Cells(r, 3) = "0" Then Rows(r).Delete
        Next r
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    Set rng1 = Worksheets("Sheet2").Range("B1")
    Set rng2 = rng1.End(xlDown)
    Set totalRng = Range(rng1, rng2)
    For Each cell In totalRng
        If cell.Value = cell.Offset(1, 0).Value Then
            cell.Rows.EntireRow.Delete Shift:=xlUp
        End If
    Next cell
    '    Dim rng1 As Variant, rng2 As Variant, totalRng As Variant, cell As Variant
    Set rng1 = Worksheets("Sheet2").Range("B1")
    Set rng2 = rng1.End(xlDown)
    Set totalRng = Range(rng1, rng2)
    For Each cell In totalRng
        If cell.Value = cell.Offset(1, 0).Value Then
            cell.Rows.EntireRow.Delete Shift:=xlUp
        End If
    Next cell
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "=(RC[-1]-R[1]C[-1])/R[1]C[-1]"
    Range("D1:D2").Select
    Selection.AutoFill Destination:=Range("D1:D27632")
    Range("D1:D27632").Select
    Selection.Copy
    Columns("D:D").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Columns("B:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
 
 
 
        For r = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
            If Cells(r, 1) = "" Then Rows(r).Delete
        Next r
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    Columns("B:B").Select
    Selection.Style = "Percent"
    Columns("A:B").Select
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range( _
            "B1:B56142"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange Range("A1:B56142")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

John

Hi drmix

WOW! Glad we got through that! Now, to mark your thread as solved, you need to do this:

To mark your thread solved do the following:
- Go to your first post on the thread
- Click edit
- Click Advance
- Just below the word "Title:" you will see a dropdown with the word No prefix.
- Change to Solve
- Click Save

A click on the scales (upper right hand corner of my post) is always appreciated.

John