Home > front end >  How do I put all these codes together to function as a single module?
How do I put all these codes together to function as a single module?

Time:04-29

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
  • Related