Lio Djo
Lio Djo

Reputation: 129

How do I put all these codes together to function as a single module?

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

Upvotes: 1

Views: 46

Answers (2)

TinMan
TinMan

Reputation: 7759

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, "H"
    DeleteSheet1Criteria DeleteEmployeeCriteria, "CE"
    DeleteSheet1Criteria DeleteOkIssueCriteria, "CP"
    
    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

Upvotes: 1

Cyril
Cyril

Reputation: 6829

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.

Upvotes: 2

Related Questions