This question might look silly but I have never tried this before.
How do you put these different codes to work as a single module? I added a button in my worksheet hoping that it would process all the different requests once.
Worsksheet name: WC
First: ReplaceVlookupValues() is made to replace the vlookups by values so the macro can pick it up.
Second: Sub DeleteStatus() is made to delete the selected words in column H.
Third: DeleteEmployeeCriteria() is made to delete the selected words in column CE.
Fourth: DeleteOkIssueCriteria() is made to delete the selected words in column CP.
Sub ReplaceVlookupValues()
'Copy A Range of Data
Worksheets("WC").Range("A3:CP35000").Copy
'PasteSpecial Values Only
Worksheets("WC").Range("A3").PasteSpecial Paste:=xlPasteValues
'Clear Clipboard (removes "marching ants" around the original data set)
Application.CutCopyMode = False
End Sub
Sub DeleteStatus()
Application.ScreenUpdating = False
Dim toDelete As Variant
' set the words to delete
toDelete = Array("Closed", "Resigned", "TBC")
Dim colD As Range
Set col = Sheet1.Range("H3:H" & Sheet1.Range("H" & Rows.Count).End(xlUp).Row)
With col
.AutoFilter Field:=1, Criteria1:=toDelete, Operator:=xlFilterValues
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Sheet1.AutoFilterMode = False
End Sub
Sub DeleteEmployeeCriteria()
Application.ScreenUpdating = False
Dim toDelete As Variant
' set the words to delete
toDelete = Array("0NotEmployee", "1NotEmployee")
Dim colD As Range
Set col = Sheet1.Range("CE3:CE" & Sheet1.Range("CE" & Rows.Count).End(xlUp).Row)
With col
.AutoFilter Field:=1, Criteria1:=toDelete, Operator:=xlFilterValues
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Sheet1.AutoFilterMode = False
End Sub
Sub DeleteOkIssueCriteria()
Application.ScreenUpdating = False
Dim toDelete As Variant
' set the words to delete
toDelete = Array("OK")
Dim colD As Range
Set col = Sheet1.Range("CP3:CP" & Sheet1.Range("CP" & Rows.Count).End(xlUp).Row)
With col
.AutoFilter Field:=1, Criteria1:=toDelete, Operator:=xlFilterValues
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Sheet1.AutoFilterMode = False
End Sub
CodePudding user response:
Example of my comments:
Sub Execute_Routines()
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculate = xlManual
'---
ReplaceVlookupValues
DeleteEmployeeCriteria
DeleteOkIssueCriteria
'---
.EnableEvents = True
.ScreenUpdating = True
.Calculate = xlAutomatic
End with
End Sub
The above works if you're in a single module. If you work in other modules, you will need references and may need to actually use Call
.
CodePudding user response:
There is no need to call in the marching ants. Simply assign the range its own value.
SpecialCells
is not needed to delete empty rows (see example in my code). Make sure and add an Error Handler when using SpecialCells
.
Sub Main()
Dim CalculationMode As XlCalculation
Application.ScreenUpdating = False
CalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
ReplaceVlookupValues
DeleteSheet1Criteria DeleteStatusCriteria
DeleteSheet1Criteria DeleteEmployeeCriteria
DeleteSheet1Criteria DeleteOkIssueCriteria
Application.Calculation = CalculationMode
End Sub
Sub ReplaceVlookupValues()
With Worksheets("WC").Range("A3:CP35000")
.Value = .Value
End With
End Sub
Sub DeleteSheet1Criteria(Criteria As Variant, Column As Variant)
Dim Target As Range
With Sheet1.Columns(Column)
Set Target = .Cells(3, 1)
Set Target = .Cells(.Rows.Count, 1).End(xlUp)
Set Target = Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
With Target
.AutoFilter Field:=1, Criteria1:=Criteria, Operator:=xlFilterValues
.Offset(1, 0).EntireRow.Delete
End With
Sheet1.AutoFilterMode = False
End Sub
Function DeleteStatusCriteria()
DeleteStatusCriteria = Array("Closed", "Resigned", "TBC")
End Function
Function DeleteEmployeeCriteria()
DeleteEmployeeCriteria = Array("0NotEmployee", "1NotEmployee")
End Function
Function DeleteOkIssueCriteria()
DeleteOkIssueCriteria = Array("OK")
End Function