Condense 5 Macros into 1

[Jaredbuoy]

Hi All,

I have a few macros that I need to press to get the desired result - I know I can do a run macros function to run each macro but I am curious if this VBA code can be made into 1 macro instead?

Sub Step1_FilterAcc()
Dim cell As Range, cRange As Range, lastrow As Long, x As Long

lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

Set cRange = Range("A2:A" & lastrow)

For x = cRange.Cells.Count To 1 Step -1
With cRange.Cells(x)
If .Value <> "cheese shop" And .Value <> "milk shop" Then
.EntireRow.Delete
End If
End With
Next x

End Sub

Sub Step2_SortApprover()
Dim lastrow As Long
lastrow = Range("i" & Rows.Count).End(xlUp).Row
Range("a2:m" & lastrow).Sort key1:=Range("i2:i" & lastrow), ORDER1:=xlAscending, Header:=xlNo
End Sub

Sub Step3_AppendWorker()
With Range("N2:N" & Cells(Rows.Count, "I").End(xlUp).Row)
.Formula = "=IF(I2=I1,N1&"", ""&E2,E2)"
.Value = .Value
End With

End Sub
Sub Step4_TrueOrFalse()
With Range("O2:O" & Cells(Rows.Count, "I").End(xlUp).Row)
.Formula2 = "=IF(I3<>I2,True,False)"
.Value = .Value
End With

End Sub

Sub Step5_DeleteRows()

Dim cell As Range, cRange As Range, lastrow As Long, x As Long

lastrow = ActiveSheet.Cells(Rows.Count, "O").End(xlUp).Row

Set cRange = Range("O2:O" & lastrow)

For x = cRange.Cells.Count To 1 Step -1
With cRange.Cells(x)
If .Value <> True Then
.EntireRow.Delete
End If
End With
Next x
End Sub

---

So the idea is to take the sheet, filter by account (company) and delete any other if they arent the .value needed -> Sort the approver A-Z -> Run a formula to append the workers one after the other if the approver is the same -> Run a true or false if to find the longest chain of workers to an approver -> Then delete the rows if they are not the longest chain.

Thank you very much!

 

[offthelip]

The really easy way to do that is to create a new macro that calls all 5 in turn like this:

Sub CallMacros
Call Step1_FilterAcc()
Call Step2_SortApprover()
Call Step3_AppendWorker()
Call Step4_TrueOrFalse()
Call Step5_DeleteRows()
end sub