Skip to content

Instantly share code, notes, and snippets.

@vascoferreira25
Last active March 18, 2021 22:02
Show Gist options
  • Save vascoferreira25/fffc9948124c6ddf404d654da39fdb2b to your computer and use it in GitHub Desktop.
Save vascoferreira25/fffc9948124c6ddf404d654da39fdb2b to your computer and use it in GitHub Desktop.
Remove rows based on a condition and add new columns to a table
'******************************************************************************
' Author: Vasco Ferreira
' Description: Increase performance of Excel when running heavy subs
' Version: 0.1
' Instructions: Add this module to the workbook and call its subs
' Revisions: TODO
' - Date: 2019/03/10
' - Author: Vasco Ferreira
' - Description: Init
'@Folder("Utilities")
Option Explicit
'******************************************************************************
'******************************************************************************
' Description: Increase performance by disabling the screen update
' and automatic calculations.
'******************************************************************************
Public Sub ToggleExcelUpdates(toggle As Boolean)
Application.ScreenUpdating = toggle
Application.DisplayStatusBar = toggle
Application.EnableEvents = toggle
If toggle Then
Application.Calculation = xlAutomatic
Application.Calculate
Else
Application.Calculation = xlManual
End If
End Sub
'******************************************************************************
' Description: Executes cleanup code at the end of each Sub, re-activates the
' current worksheet and shows the Sub runtime.
' It can be made public to handle cleanup code on other modules.
' Arguments: currentWorksheet
' startingTime - value of starting time
'******************************************************************************
Public Sub Cleanup(currentWorksheet As Worksheet, startingTime As Double)
' Re-enable Screen update and automatic calculations
ToggleExcelUpdates True
' Re-activate current worksheet
currentWorksheet.Activate
' Show executionRuntime
' MsgBox "Execution time: " & _
(Timer - startingTime) & " seconds.", _
vbOkOnly + vbInformation, "Procedure Execution Time"
Debug.Print "Execution time: " & (Timer - startingTime) & " seconds."
End Sub
'******************************************************************************
' Description: Handles all the errors and executes cleanup code afterwards
' It can be made public to handle cleanup code on other modules.
' Arguments: currentWorksheet
' startingTime - value of starting time
'******************************************************************************
Public Sub ErrHandler(currentWorksheet As Worksheet, startingTime As Double)
' Handle specific errors
Select Case Err.Number
Case 0
' No error
Case Else
' Show the Error Handling form with the error number and message
'frm_ErrorHandling.DisplayErrorForm Err.Number, Err.Description
Debug.Print "+++ Error: " & Err.Number & ": " & Err.Description
End Select
Cleanup currentWorksheet, startingTime
End Sub
'******************************************************************************
' Author: TODO
' Description: TODO
' Version: 0.1
'
' Instructions: TODO
'
' Revisions: TODO
' - Date: yyyy/mm/dd
' - Author:
' - Description:
Option Explicit
'******************************************************************************
'******************************************************************************
' Description:
' Arguments:
' Returns:
'******************************************************************************
Sub RemoveInvalidDataAndFormatTable()
' Start Sub timer
Dim executionRuntime As Double
executionRuntime = Timer
' Turn off screen update and automatic calculations
m_CleanupAndPerformance.ToggleExcelUpdates False
Dim currentWorkbook As Workbook
Dim currentWorksheet As Worksheet
' `ThisWorkbook` won't work when an add-in tries to manipulate another
' workbook because `ThisWorkbook` will point to the add-in's workbook.
Set currentWorkbook = ActiveWorkbook
Set currentWorksheet = currentWorkbook.ActiveSheet
' When something bad happens, panic! Execute the cleanup to enable excel
' updates and calculations again.
On Error GoTo ErrorHandling
'**************************************************************************
Dim curWorksheet As Worksheet
For Each curWorksheet In currentWorkbook.workSheets
Dim table As Variant
For Each table In curWorksheet.ListObjects
Dim tableDataRange As Range
Set tableDataRange = table.DataBodyRange
' Create an array to store the data from the table
Dim tableData As BetterArray
Set tableData = New BetterArray
tableData.FromExcelRange tableDataRange, False, False
' Create an array to store the data we want to keep
' I hope this is faster than removing and resizing the array
Dim finalData As BetterArray
Set finalData = New BetterArray
' Check which rows you want to keep
Dim i As Long
For i = 1 To tableData.UpperBound
' Filter rows with this condition
If tableData(i)(4) < 7000 Then
finalData.Push (tableData(i))
End If
Next
' Pass the data to the worksheet
tableDataRange.Clear
finalData.ToExcelRange tableDataRange
' Add more columns
Dim newColumnA As ListColumn
Set newColumnA = table.ListColumns.Add
newColumnA.Name = "Tax"
' Store the data of the new column in a new array
Dim columnData As BetterArray
Set columnData = New BetterArray
' Pushing an array to another makes it 0 index based
' So, subtract one from the index you want
Dim columnIndex As Integer
columnIndex = 4 - 1
Dim j As Long
For j = 1 To finalData.UpperBound
' Tax is 25% of revenue
columnData.Push (finalData(j)(columnIndex) * 0.25)
Next
' Set the values of the new column
columnData.ToExcelRange newColumnA.DataBodyRange
Next table
Next curWorksheet
'**************************************************************************
' Enable calculations and screen updates
m_CleanupAndPerformance.Cleanup currentWorksheet, executionRuntime
Exit Sub
ErrorHandling:
' If something goes wrong, enable calculations and screen updates
m_CleanupAndPerformance.ErrHandler currentWorksheet, executionRuntime
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment