L
lunker55
I want 3 different macros to run, but I want the user to be able to press 1
button only.
Do I have to nest them within each other?
Joe
Sub Macro3()
Rows("3:2000").Select
Selection.Sort Key1:=Range("B3"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveWindow.ScrollRow = 3
Range("B5").Select
End Sub
Public Sub DeleteBlankRows()
Dim R As Long
Dim C As Range
Dim Rng As Range
On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If
For R = Rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(Rng.Rows(R).EntireRow) = 0 Then
Rng.Rows(R).EntireRow.Delete
End If
Next R
EndMacro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub insert_rows()
Dim lastrow As Long
Dim row_index As Long
lastrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
For row_index = lastrow - 1 To 1 Step -1
If Cells(row_index, "B").Value <> Cells(row_index + 1, "B"). _
Value Then
Cells(row_index + 1, "B").Resize(2, 1).EntireRow. _
Insert (xlShiftDown)
Cells(row_index + 1, "B").Resize(2, 1).EntireRow. _
Interior.ColorIndex = 15
End If
Next
End Sub
button only.
Do I have to nest them within each other?
Joe
Sub Macro3()
Rows("3:2000").Select
Selection.Sort Key1:=Range("B3"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveWindow.ScrollRow = 3
Range("B5").Select
End Sub
Public Sub DeleteBlankRows()
Dim R As Long
Dim C As Range
Dim Rng As Range
On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If
For R = Rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(Rng.Rows(R).EntireRow) = 0 Then
Rng.Rows(R).EntireRow.Delete
End If
Next R
EndMacro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub insert_rows()
Dim lastrow As Long
Dim row_index As Long
lastrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
For row_index = lastrow - 1 To 1 Step -1
If Cells(row_index, "B").Value <> Cells(row_index + 1, "B"). _
Value Then
Cells(row_index + 1, "B").Resize(2, 1).EntireRow. _
Insert (xlShiftDown)
Cells(row_index + 1, "B").Resize(2, 1).EntireRow. _
Interior.ColorIndex = 15
End If
Next
End Sub