AWE_Sheet removes the complexity of finding, retrieving, and updating data in your spreadsheet that would otherwise require Named Ranges, a Table, or a dozen lines of code. AWE_Sheet is packed with macros that allows you to quickly find, retrieve, and manipulate data on your sheet with just a few lines of code so you can more easily focus on the business problem. AWE_Sheet extends Worksheet functionality allowing you to continue using Excel's great interface, i.e., AutoFilter, SpecialCells… Best yet, all source code is included (see the below implementation section for the code) and it’s FREE.
Implementation
Copy the below code to a Class Module called AWE_Sheet in your Workbook (see How to Create a Class for more information). Function definitions, parameters and examples are included in the comments before each function. Additionally, Visual Basics Class IntelliSense will provide a code completion aid for the AWE_Sheet Class Module by listing its functions and parameters while you code.
'*****************************************************************************************************
'*****************************************************************************************************
'* AWE_Sheet: AWE_Sheet removes the complexity of finding, and updating data in a spreadsheet **
'* that would otherwise require cumbersome Named Ranges, a Table, or a dozen lines of **
'* code. AWE_Sheet is packed with macros that allow you to find, retrieve, and **
'* manipulate data on your sheet with just a few calls so you can more easily focus on **
'* the business problem. AWE_Sheet extends Worksheet functionality allowing you to **
'* continue using Excel's great interface, i.e., AutoFilter, SpecialCells… **
'* Author: Mike Libby **
'* Website: AutomationWithExcel.com
'*****************************************************************************************************
'*****************************************************************************************************
Option Explicit
'====================================================================================================
'== PRIVATE VARIABLES ===============================================================================
'====================================================================================================
Private m_Worksheet As Worksheet '--- Worksheet that is used by this class ---
Private m_HdrRowNb As Long '--- The one and only header row number that is on the sheet
Private m_Timer As Single '--- Timer that is set in ScreenOff and retuned in ScreenOn
Private m_HdrArr As Variant '--- An array of header columns
Private m_RowKeyDtaArr() As Variant '--- An array of rows with one or more column values
Private m_RowKeyHdrArr() As Variant '--- An array of column names that defines RowKeyArray
'====================================================================================================
'== INITIALIZE ======================================================================================
'====================================================================================================
'----------------------------------------------------------------------------------------------------
' Initialize - Initialize and extend Worksheet functionality
' Parameters:
' TableOrSheetNmOrObj as Variant - A Worksheet name (String), Worksheet Object, or Table ListObject
' Optional HdrRowNb as Long - The header's row number. Default = 1
' Optional WB as Workbook - The Worksheet's Workbook Object or FullFileName. Default = ThisWorkbook.
'
' Examples:
' ActiveSheet - Dim AWESh as new AWE_Sheet: AWESh.Initialize ActiveSheet, 3
' Sheet name - Dim AWESh as new AWE_Sheet: AWESh.Initialize "Worksheet Name", 3
' Table Name - Dim AWESh as new AWE_Sheet: AWESh.Initialize ActiveSheet.ListObjects("TableNm")
' Read only Workbook - Dim AWESh as new AWE_Sheet: AWESh.Initialize "ShNm", 3, "FullFileNm", True
'----------------------------------------------------------------------------------------------------
Public Function Initialize(TableOrSheetNmOrObj As Variant, Optional HdrRowNb As Long = 1, _
Optional WBFullFileNmOrObj As Variant = Nothing, _
Optional WBReadOnly As Boolean = False)
Dim wb As Workbook
Set m_Worksheet = Nothing
'--- Workbook ---
Select Case TypeName(WBFullFileNmOrObj)
Case "Workbook": Set wb = WBFullFileNmOrObj
Case "String": Set wb = Workbooks.Open(Filename:=WBFullFileNmOrObj, ReadOnly:=WBReadOnly)
Case Else: Set wb = ThisWorkbook
End Select
'--- Worksheet ---
Select Case TypeName(TableOrSheetNmOrObj)
Case "Worksheet": Set m_Worksheet = TableOrSheetNmOrObj
Case "String": Set m_Worksheet = wb.Sheets(CStr(TableOrSheetNmOrObj))
Case "ListObject"
Set m_Worksheet = TableOrSheetNmOrObj.Parent
HdrRowNb = TableOrSheetNmOrObj.HeaderRange.Row
End Select
'--- Worksheet not found, Critical Error Msg, Stop Processing ---
If m_Worksheet Is Nothing Then
MsgBox "Invalid Sheet - Ensure the sheet exists within the Workbook", vbCritical: End
End If
'--- Header Row ---
m_HdrRowNb = HdrRowNb
RefreshHdrRow
End Function
Public Function RefreshHdrRow()
If IsArray(m_HdrArr) Then Erase m_HdrArr
m_HdrArr = HeaderRange.Value
End Function
'====================================================================================================
'== COLUMNS =========================================================================================
'====================================================================================================
'----------------------------------------------------------------------------------------------------
' ColNbr - Search for and return a Column's number on the header row
' Params: ColNbrOrNameOrRange as Variant. A column number, name, or Range.
' Example: Dim iCol as Long: iCol = AWESh.ColNbr("Column Name")
' Note: a critical message displays if the column is not found and then processing stops.
'----------------------------------------------------------------------------------------------------
Public Function ColNbr(ColNbrOrNameOrRange As Variant) As Long
On Error Resume Next: ColNbr = -1
If IsNumeric(ColNbrOrNameOrRange) Then ColNbrOrNameOrRange = CLng(ColNbrOrNameOrRange)
Select Case TypeName(ColNbrOrNameOrRange)
Case "Integer", "Long": ColNbr = CLng(ColNbrOrNameOrRange)
Case "Range": ColNbr = HeaderRange.Columns(ColNbrOrNameOrRange.Column).Column
Case "String": ColNbr = SearchArr(CStr(ColNbrOrNameOrRange), m_HdrArr)
'--- Refresh header row if not found. Column could be added in processing ---
If ColNbr = -1 Then
RefreshHdrRow
ColNbr = SearchArr(CStr(ColNbrOrNameOrRange), m_HdrArr)
End If
End Select
If ColNbr = -1 Then
MsgBox "ColNbr::ColNbrOrNameOrRange " & ColNbrOrNameOrRange & _
" does not exist in the header row on sheet " & m_Worksheet.Name: End
End If
End Function
'----------------------------------------------------------------------------------------------------
' FirstCol - Return the header row's first column number
' Example: Dim iCol as Long: iCol = AWESh.FirstCol
'----------------------------------------------------------------------------------------------------
Public Property Get FirstCol() As Long
FirstCol = 1
End Property
'----------------------------------------------------------------------------------------------------
' LastCol - Return the header row's last column number
' Example: Dim iCol as Long: iCol = AWESh.LastCol
'----------------------------------------------------------------------------------------------------
Public Property Get LastCol() As Long
LastCol = m_Worksheet.Cells(m_HdrRowNb, m_Worksheet.Columns.Count).End(xlToLeft).Column
End Property
'====================================================================================================
'== ROWS ============================================================================================
'====================================================================================================
'----------------------------------------------------------------------------------------------------
' FirstDataRow - Return the first data row's (the row under the header row) number.
' Example: Dim iRow as Long: iRow = AWESh.FirstDataRow
'----------------------------------------------------------------------------------------------------
Public Property Get FirstDataRow() As Long
FirstDataRow = m_HdrRowNb + 1
End Property
'----------------------------------------------------------------------------------------------------
' HdrRow - Return the header row that was specified in the Intialize Function
' Example: Dim iRow as Long: iRow = AWESh.HdrRow
'----------------------------------------------------------------------------------------------------
Public Property Get HdrRow() As Long
HdrRow = m_HdrRowNb
End Property
'----------------------------------------------------------------------------------------------------
' LastDataRow - Return the last data row's number
' Example: Dim iRow as Long: iRow = AWESh.LastDataRow
'----------------------------------------------------------------------------------------------------
Public Property Get LastDataRow() As Long
LastDataRow = m_Worksheet.Cells.Find("*", LookAt:=xlPart, LookIn:=xlFormulas, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'--- Ensure that the HdrRow isn't returned in the range ---
If LastDataRow <= m_HdrRowNb Then
LastDataRow = m_Worksheet.UsedRange.Rows.Count
If LastDataRow <= m_HdrRowNb Then LastDataRow = m_HdrRowNb + 1
End If
End Property
'----------------------------------------------------------------------------------------------------
' RowNbr - Search for a Row by Row number or search value and if found, return the row number.
' Params: RowNbrOrSrchVal As Variant - A sheet's row number or value to find within the column.
' ColNbrOrName As Variant - A column number or name on the sheet.
' Optional SearchDirection As Long = xlNext - Search direction (xlNext or xlPrevious) to use.
' Example: Dim iRow as Long: iRow = AWESh.RowNb("SearchVal", "Column Name")
'----------------------------------------------------------------------------------------------------
Public Function RowNbr(RowNbrOrSrchVal As Variant, ColNbrOrName As Variant, _
Optional SearchDirection As XlSearchDirection = xlNext) As Long
Dim iCol As Long, rng As Range, iRow As Long
If IsNumeric(ColNbrOrName) Then iCol = CLng(ColNbrOrName) Else iCol = ColNbr(ColNbrOrName)
If IsNumeric(RowNbrOrSrchVal) Then
iRow = RowNbrOrSrchVal
Else
Set rng = SearchFor(DataColumns(iCol), CStr(RowNbrOrSrchVal), SearchDirection)
If rng Is Nothing Then RowNbr = -1 Else RowNbr = rng.Row
End If
End Function
'====================================================================================================
'== RANGE ===========================================================================================
'====================================================================================================
'----------------------------------------------------------------------------------------------------
' Cell As Range - Search for and return cell's range; otherwise, return nothing
' Params: RowNbrOrSrchVal As Variant - A sheet's row number or value to find within the column.
' ColNbrOrName As Variant - A column number or name on the sheet.
' Optional SearchDirection As Long = xlNext - Search direction (xlNext or xlPrevious) to use.
' Example: Dim rng As Range: set rng = AWESh.Cell ("Search Value", "Column Name", xlNext)
'----------------------------------------------------------------------------------------------------
Public Function Cell(RowNbrOrSrchVal As Variant, ColNbrOrName As Variant, _
Optional SearchDirection As XlSearchDirection = xlNext) As Range
Dim iCol As Long, iRow As Long
If IsNumeric(ColNbrOrName) Then iCol = CLng(ColNbrOrName) Else iCol = ColNbr(ColNbrOrName)
If IsNumeric(RowNbrOrSrchVal) Then iRow = CLng(RowNbrOrSrchVal) _
Else: iRow = RowNbr(RowNbrOrSrchVal, iCol, SearchDirection)
If iRow <> -1 Then Set Cell = m_Worksheet.Cells(iRow, iCol) Else Set Cell = Nothing
End Function
'----------------------------------------------------------------------------------------------------
' FindCells As Array - Search for and return cell ranges in an array; otherwise, return empty array
' Params: RowSrchVal As Variant - A sheet's row value to find within the column.
' ColNbrOrName As Variant - A column number or name on the sheet.
' Optional SearchDirection As Long = xlNext - Search direction (xlNext or xlPrevious) to use.
' Returns: Array of found cells. If no cells are found then ubound(array) will equal -1
' Example: Dim arr As Variant: arr = AWESh.FindCells ("Search Value", "Column Name", xlNext)
' or: Dim rng as Range
' For Each rng In AWESh.FindCells ("Search Value", "Column Name", xlNext)
' Debug.Print AWESh.Cell(rng.Row, "Column Name").Value
' Next rng
'----------------------------------------------------------------------------------------------------
Public Function FindCells(RowSrchVal As Variant, ColNbrOrName As Variant, _
Optional SearchDirection As XlSearchDirection = xlNext) As Variant
Dim iCol As Long, rCol As Range, rFirst As Range, rCell As Range
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
If IsNumeric(ColNbrOrName) Then iCol = CLng(ColNbrOrName) Else iCol = ColNbr(ColNbrOrName)
Set rCol = DataColumns(ColNbrOrName)
Set rFirst = rCol.Find(What:=CStr(RowSrchVal), LookIn:=xlValues, SearchOrder:=xlByRows, _
SearchDirection:=SearchDirection, LookAt:=xlWhole)
Set rCell = rFirst
While Not rCell Is Nothing
Set dict(rCell.Address) = rCell
Set rCell = rCol.FindNext(rCell)
'--- Exit loop if first cell reached again ---
If rCell.Address = rFirst.Address Then Set rCell = Nothing
Wend
FindCells = dict.Items
End Function
'----------------------------------------------------------------------------------------------------
' ColHdr - Find and return a column header's cell range.
' Params: ColNbrOrNameOrRange as Variant. A column number, name, or Range.
' Example: Dim rng As Range: set rng = AWESh.ColHdr "Column Name"
'----------------------------------------------------------------------------------------------------
Public Function ColHdr(ColNbrOrNameOrRange As Variant) As Range
Set ColHdr = m_Worksheet.Cells(m_HdrRowNb, ColNbr(ColNbrOrNameOrRange))
End Function
'----------------------------------------------------------------------------------------------------
' DataBodyRange - Return the range for all rows under the sheet header
' Example: Dim rng As Range: set rng = AWESh.DataBodyRange
'----------------------------------------------------------------------------------------------------
Public Property Get DataBodyRange(Optional IncludeHeader As Boolean = False) As Range
Dim iFirstRow As Long: If IncludeHeader = True Then iFirstRow = m_HdrRowNb Else iFirstRow = m_HdrRowNb + 1
With m_Worksheet
Set DataBodyRange = .Range(.Cells(iFirstRow, 1), .Cells(LastDataRow, LastCol))
End With
End Property
'----------------------------------------------------------------------------------------------------
' DataColumns - Return the range for one or more columns
' Params: ColNbrOrNameOrRanges as Variant. A list of column numbers, names, or Ranges.
' Example: Dim rng As Range: set rng = DataColumns("Column 1", "Column 5", "Column 6")
'----------------------------------------------------------------------------------------------------
Public Function DataColumns(ParamArray ColNbrsOrNamesOrRanges() As Variant) As Range
Dim RtnRng As Range, var As Variant
For Each var In ColNbrsOrNamesOrRanges
If RtnRng Is Nothing Then
Set RtnRng = DataBodyRange.Columns(ColNbr(var))
Else
Set RtnRng = Union(RtnRng, DataBodyRange.Columns(ColNbr(var)))
End If
Next var
Set DataColumns = RtnRng
End Function
'----------------------------------------------------------------------------------------------------
' HeaderRange - Return the range for the entire header row
' Example: Dim rng As Range: set rng = AWESh.HeaderRange
'----------------------------------------------------------------------------------------------------
Public Property Get HeaderRange() As Range
With m_Worksheet
Set HeaderRange = .Range(.Cells(m_HdrRowNb, 1), .Cells(m_HdrRowNb, LastCol))
End With
End Property
'----------------------------------------------------------------------------------------------------
' UsedRange - Return the used range for the entire sheet (more reliable the Worksheet.UsedRange)
' Example: Dim rng As Range: set rng = AWESh.UsedRange
'----------------------------------------------------------------------------------------------------
Public Property Get UsedRange() As Range
With m_Worksheet
Set UsedRange = .Range("A1", .Cells(LastDataRow, LastCol))
End With
End Property
'----------------------------------------------------------------------------------------------------
' SearchFor - Searches through a range of data for a value and returns its cell.
' Params: SearchRange as Range - The range on the sheet to search through.
' SearchVal as String - The value to search for.
' Optional SearchDirection As Long = xlNext - Search direction (xlNext or xlPrevious) to use.
' Example: Dim rng As Range: set rng = AWESh.SearchFor (SrchRange, "Search Value", xlNext)
' Note: Use Excel's FindNext and FindPrevious to find the next/previous SearchVal in the column.
'----------------------------------------------------------------------------------------------------
Public Function SearchFor(ByRef SearchRange As Range, SearchVal As String, _
Optional SearchDirection As XlSearchDirection = xlNext) As Range
Dim SrchOrd As Variant, SrchAfter As Range
If SearchRange.Columns.Count > 1 Then SrchOrd = xlByColumns Else SrchOrd = xlByRows
On Error Resume Next: Set SearchFor = Nothing
With SearchRange
If SearchDirection = xlPrevious Then
Set SearchFor = .Find(What:=SearchVal, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=SrchOrd, SearchDirection:=SearchDirection, MatchCase:=False)
Else
Set SearchFor = .Find(What:=SearchVal, after:=.Cells(.Cells.Count), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=SrchOrd, SearchDirection:=SearchDirection, _
MatchCase:=False)
End If
End With
End Function
'====================================================================================================
'== SHEET ===========================================================================================
'====================================================================================================
'----------------------------------------------------------------------------------------------------
' ScreenOff - Turns screen off.
' Example - AWESh.ScreenOff
'----------------------------------------------------------------------------------------------------
Public Function ScreenOff()
With Application
.ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual: .Cursor = xlWait: m_Timer = Timer
End With
End Function
'----------------------------------------------------------------------------------------------------
' ScreenOn - Turns screen on and returns the process time (hh:mm:ss) from when ScreenOff was called.
' Example - Dim ProcessTime as string: ProcessTime = AWESh.ScreenOn
'----------------------------------------------------------------------------------------------------
Public Function ScreenOn() As String
With Application
ScreenOn = Format((Timer - m_Timer) / 86400, "hh:mm:ss") & " seconds"
.ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic: .Cursor = xlDefault
End With
End Function
'----------------------------------------------------------------------------------------------------
' Sheet - Returns the worksheet used by AWE_Sheet
' Examples - Dim sh as Worksheet: set sh = AWESh.Sheet
'----------------------------------------------------------------------------------------------------
Public Property Get Sheet() As Worksheet
Set Sheet = m_Worksheet
End Property
'----------------------------------------------------------------------------------------------------
' Workbook - Returns the Workbook used by AWE_Sheet
' Examples - Dim wb as Workbook: set wb = AWESh.Workbook
'----------------------------------------------------------------------------------------------------
Public Property Get Workbook() As Workbook
Set Workbook = m_Worksheet.Parent
End Property
'----------------------------------------------------------------------------------------------------
' SortSheet - Sort the sheet by values in one or more columns.
' Parameter:
' ColIdxOrNames As Variant - Column numbers or names to sort by. Prepend "<" to reverse sort.
' Example: Sort Col1 ascending and Col2 decending - AWESh.Sort "Col1 Name", "<Col2 Name"
'----------------------------------------------------------------------------------------------------
Public Function SortSheet(ParamArray ColIdxOrNames() As Variant)
Dim ColIdxOrName As Variant, ColIdx As Long
With m_Worksheet.Sort
For Each ColIdxOrName In ColIdxOrNames
If Left(ColIdxOrName, 1) = "<" Then
ColIdxOrName = Trim(Right(ColIdxOrName, Len(ColIdxOrName) - 1))
.SortFields.Add key:=DataColumns(ColNbr(ColIdxOrName)), Order:=xlDescending
Else
If Left(ColIdxOrName, 1) = ">" Then _
ColIdxOrName = Trim(Right(ColIdxOrName, Len(ColIdxOrName) - 1))
.SortFields.Add key:=DataColumns(ColNbr(ColIdxOrName)), Order:=xlAscending
End If
Next
.SetRange DataBodyRange: .Header = xlNo: .Apply: .SortFields.Clear
End With
End Function
'====================================================================================================
'== FILTER ==========================================================================================
'====================================================================================================
'----------------------------------------------------------------------------------------------------
' ClearSheetFilters - Clears all Filters on the Sheet
' Parameter:
' Optional SheetPWD As String - Password to unprotect the sheet. Default = ""
' Example: AWESh.ClearSheetFilters
' Note: Displays a message and ends processing if the sheet is protected and the PWD is not provided.
'----------------------------------------------------------------------------------------------------
Public Function ClearSheetFilters(Optional SheetPWD As String = "")
Dim rCol As Range, cnt As Long, dict As Object
'--- Unprotect the Sheet and get protection parameters ---
If SheetPWD <> "" Then Set dict = UnprotectSheet(SheetPWD)
'--- Verify that the sheet isn't protected ---
If m_Worksheet.ProtectContents = True Then
MsgBox "Error: " & m_Worksheet.Name & " - Unprotect sheet before using VBA to clear filters.": End
End If
'--- Perform test to ensure that the sheet has filter drop down buttons ---
On Error Resume Next
cnt = m_Worksheet.AutoFilter.Range.Areas.Count
If Err.Number > 0 Then
HeaderRange.AutoFilter field:=1, VisibleDropDown:=True
End If
On Error GoTo 0
'--- Remove all filters ---
If Not m_Worksheet.AutoFilter Is Nothing And m_Worksheet.FilterMode = True Then
m_Worksheet.ShowAllData
End If
'--- Protect the sheet with previously retrieved sheet protection parameters ---
If SheetPWD <> "" Then ProtectSheet dict
End Function
'----------------------------------------------------------------------------------------------------
' IsFiltered - Returns True if there is a filter on the sheet.
' Example: Dim bFiltered as Boolean: bFiltered = AWESh.IsFiltered
'----------------------------------------------------------------------------------------------------
Public Property Get IsFiltered() As Boolean
IsFiltered = False
If m_Worksheet.FilterMode Then
If m_Worksheet.AutoFilter.Range.Areas.Count > 0 Then
IsFiltered = True
End If
End If
End Property
'----------------------------------------------------------------------------------------------------
' IsRowVisible - Returns True if a role is visible; otherwise, False.
' Example: Dim bIsRowVisible as boolean: bIsRowVisible = AWESh.IsRowVisible(iRow)
'----------------------------------------------------------------------------------------------------
Public Property Get IsRowVisible(iRow As Long) As Boolean
If m_Worksheet.Rows(iRow).Hidden = False Then IsRowVisible = True
End Property
'====================================================================================================
'== Protection ======================================================================================
'====================================================================================================
'----------------------------------------------------------------------------------------------------
' UnprotectSheet - Unprotects the sheet and return a dictionary (key pairs) of propection parameters.
' Parameter:
' Optional SheetPWD As String - Password to unprotect the sheet. Default = ""
' Example: Dim dict as Object: set dict = AWESh.UnprotectSheet ("Password")
'----------------------------------------------------------------------------------------------------
Public Function UnprotectSheet(SheetPWD As String) As Object
Dim prop As String, arr As Variant, key As Variant, dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict("SheetPWD") = SheetPWD
For Each key In Array("ProtectDrawingObjects", "ProtectContents", "ProtectScenarios", "ProtectionMode", _
"Protection.AllowFormattingCells", "Protection.AllowFormattingColumns", "Protection.AllowFormattingRows", _
"Protection.AllowInsertingColumns", "Protection.AllowInsertingRows", "Protection.AllowInsertingHyperlinks", _
"Protection.AllowDeletingColumns", "Protection.AllowDeletingRows", _
"Protection.AllowSorting", "Protection.AllowFiltering", "Protection.AllowUsingPivotTables")
arr = Split(key, ".")
Select Case arr(0)
Case "Protection": dict(key) = CallByName(m_Worksheet.Protection, arr(1), VbGet)
Case Else: dict(key) = CallByName(m_Worksheet, arr(0), VbGet)
End Select
Next key
If m_Worksheet.ProtectContents = True Then m_Worksheet.Unprotect SheetPWD
Set UnprotectSheet = dict
End Function
'----------------------------------------------------------------------------------------------------
' ProtectSheet - Protects the sheet using the parameters retrieved in the call to UnprotectSheet.
' Parameter:
' dict as Object - Scripting.Dictionary (key pairs) that was created in the call to UnprotectSheet.
' Example: AWESh.ProtectSheet (dict)
'----------------------------------------------------------------------------------------------------
Public Function ProtectSheet(dict As Object)
If m_Worksheet.ProtectContents = False Then
m_Worksheet.Protect Password:=dict("SheetPWD"), _
DrawingObjects:=dict("ProtectDrawingObjects"), contents:=dict("ProtectContents"), Scenarios:=dict("protectScenarios"), userinterfaceonly:=dict("ProtectionMode"), _
AllowFormattingCells:=dict("Protection.AllowFormattingCells"), AllowFormattingColumns:=dict("Protection.AllowFormattingColumns"), AllowFormattingRows:=dict("Protection.AllowFormattingRows"), _
AllowInsertingColumns:=dict("Protection.AllowInsertingColumns"), AllowInsertingRows:=dict("Protection.AllowInsertingRows"), AllowInsertingHyperlinks:=dict("Protection.AllowInsertingHyperlinks"), _
AllowDeletingColumns:=dict("Protection.AllowDeletingColumns"), AllowDeletingRows:=dict("Protection.AllowDeletingRows"), _
AllowSorting:=dict("Protection.AllowSorting"), AllowFiltering:=dict("Protection.AllowFiltering"), AllowUsingPivotTables:=dict("Protection.AllowUsingPivotTables")
End If
End Function
'====================================================================================================
'== Index ===========================================================================================
'====================================================================================================
'----------------------------------------------------------------------------------------------------
' SearchArr as long - Returns the array occurance where the search string was found; otherwise, -1
' Params: SrchStr as String - Value to search for
' Arr as Variant - An array of values
' Example: Dim filter as Boolean: filter = AWESh.IsFiltered
'----------------------------------------------------------------------------------------------------
Public Function SearchArr(SrchStr As String, arr As Variant) As Long
On Error Resume Next
SearchArr = -1: SearchArr = Application.Match(SrchStr, arr, 0)
End Function
'----------------------------------------------------------------------------------------------------
' CreateRowKeys - Create a row key index based on one or more columns.
' Return: An Array of rows with combined column values.
' Params: ParamArray ColIdxOrNames - One or more column indexes or names to use in creating the index.
' Example: Dim arrRowKeys as variant: arrRowKeys = CreateRowIdx("Column1", "Column2")
'----------------------------------------------------------------------------------------------------
Public Function CreateRowKeys(ParamArray ColIdxOrNames() As Variant) As Variant
Dim iArr As Long, arr As Variant, iCol As Long, iRow As Long, ColIdxOrName As Variant
'--- Reset arrays ---
ReDim m_RowKeyHdrArr(LBound(ColIdxOrNames) To UBound(ColIdxOrNames))
ReDim m_RowKeyDtaArr(1 To LastDataRow - HdrRow)
'--- Iterate and retrieve and store column headers and data in arrays ---
For iCol = LBound(ColIdxOrNames) To UBound(ColIdxOrNames)
ColIdxOrName = ColIdxOrNames(iCol) '--- Retrieve the colun name or index ---
m_RowKeyHdrArr(iCol) = ColIdxOrName '--- Save the column name or index ---
arr = DataColumns(ColIdxOrName).Value '--- Retrieve all data rows for the column ---
iRow = 1 '--- Reset the m_RowKeyDtaArr row counter ---
For iArr = LBound(arr) To UBound(arr)
m_RowKeyDtaArr(iRow) = m_RowKeyDtaArr(iRow) & "[" & Trim(arr(iArr, 1)) & "]"
iRow = iRow + 1 '--- Increment the m_RowKeyDtaArr row counter ---
Next iArr '--- Next array row ---
Next iCol '--- Next column in the ColIdxOrNames ---
CreateRowKeys = m_RowKeyDtaArr
End Function
'----------------------------------------------------------------------------------------------------
' AppendRowKey - Add a row to the KeyArray and to the Worksheet
' Params: ParamArray ColValues - Column values to use in appending the KeyArray and Worksheet.
' Example: AppendRowKey("Column1Value", "Column2Value")
'----------------------------------------------------------------------------------------------------
Public Function AppendRowKey(ParamArray Values() As Variant) As Long
Dim val As Variant, sSrchStr As String, iRow As Long, iCol As Long, ColIdxOrName As Variant
Dim iAppendRow As Long: iAppendRow = LastDataRow + 1
'--- Append new row values to the sheet and create row index key ---
For iCol = LBound(Values) To UBound(Values)
val = Values(iCol) '--- Retrieve the value from ParamArray ---
ColIdxOrName = m_RowKeyHdrArr(iCol) '--- Retrieve the column header name or idx ---
Cell(iAppendRow, ColIdxOrName).Value = val '--- Append the value to the sheet ---
sSrchStr = sSrchStr & "[" & Trim(val) & "]" '--- Create the new row index key ---
Next iCol
'--- Append the row index key to the m_rowKeyDtaArr array ---
ReDim Preserve m_RowKeyDtaArr(LBound(m_RowKeyDtaArr) To UBound(m_RowKeyDtaArr) + 1)
m_RowKeyDtaArr(UBound(m_RowKeyDtaArr)) = sSrchStr
AppendRowKey = iAppendRow
End Function
'----------------------------------------------------------------------------------------------------
' UpdateRowKey - Update a row in the KeyArray and the Worksheet
' Params: RowNbr to update, ParamArray ColIdxOrNames - One or more column indexes or names to use in creating the index.
' Example: UpdateRowKey(RowNbr, "Column1Value", "Column2Value")
'----------------------------------------------------------------------------------------------------
Public Function UpdateRowKey(RowNbr As Long, ParamArray Values() As Variant)
Dim val As Variant, sSrchStr As String, iRow As Long, iCol As Long, ColIdxOrName As Variant
'--- Update row values on the Worksheet and row key array ---
For iCol = LBound(Values) To UBound(Values)
val = Values(iCol) '--- Retrieve the value from ParamArray ---
ColIdxOrName = m_RowKeyHdrArr(iCol) '--- Retrieve the column header name or idx ---
Cell(RowNbr, ColIdxOrName).Value = val '--- Append the value to the sheet ---
sSrchStr = sSrchStr & "[" & Trim(val) & "]" '--- Create the new row index key ---
Next iCol
'--- Update the row index key to the m_rowKeyDtaArr array ---
m_RowKeyDtaArr(RowNbr - m_HdrRowNb) = sSrchStr
End Function
'----------------------------------------------------------------------------------------------------
' FindRowKey - Find a row in the KeyArray
' Returns: corresponding row in the spreadsheet
' Params: ParamArray ColIdxOrNames - One or more column indexes or names to use in creating the index.
' Example: CreateRowIdx("Column1", "Column2")
'----------------------------------------------------------------------------------------------------
Public Function FindRowKey(ParamArray Values() As Variant) As Long
Dim val As Variant, sSrchStr As String
For Each val In Values
sSrchStr = sSrchStr & "[" & Trim(val) & "]"
Next val
FindRowKey = SearchArr(sSrchStr, m_RowKeyDtaArr)
If FindRowKey > 0 Then FindRowKey = FindRowKey + m_HdrRowNb
End Function
AWE_Sheet Examples
Finding, retrieving and updating cells typically require “Named Ranges” a “Table” or a dozen lines of code. AWE_Sheet only requires only a few lines of code, with or without using “Named Ranges” or Tables!
The below examples provide 3 methods for finding, retrieving and updating data on a Worksheet, Filters, Find, and a Loop. The best part, AWE_Sheet simplifies worksheet functionality. It does not change how you work with the sheet or ranges so you still have access to all of the power native Excel VBA has to offer.
Search Using a Filter - Create a filter to find multiple values in a column. Then loop through visible rows to retrieve and update cells.
Pros: Fast performance with the ability to create complex search criteria (see Microsoft AutoFilter Documentation).
Cons: Filters can be a little complex to implement but extremely powerful once the learning curve is mastered.
Public Function SearchUsingFilter()
Dim rng As Range, aweSh As New AWE_Sheet: aweSh.Initialize ActiveSheet, 3
aweSh.ClearSheetFilters
'--- Create Filter using an Array ---
aweSh.ColHdr("TaskID").AutoFilter field:=aweSh.ColNbr("TaskID"), _
Criteria1:=Array("Task-127", "Task-145"), Operator:=xlFilterValues
'--- Add a From and To Date to the Filter ---
aweSh.ColHdr("Date").AutoFilter field:=aweSh.ColNbr("Date"), Operator:=xlAnd, _
Criteria1:=">=" & CDate("1/1/2021"), Criteria2:="<=" & CDate("12/31/2021")
'--- Loop through each found row and calculate\update its revenue ---
For Each rng In aweSh.DataColumns("Rate").SpecialCells(xlCellTypeVisible)
aweSh.Cell(rng.Row, "Rate").Value = 227.5
aweSh.Cell(rng.Row, "Revenue").Value = 227.5 * aweSh.Cell(rng.Row, "Hours").Value
'--- Add an astrict (*) next to the name to show that the value changed ---
aweSh.Cell(rng.Row, "Employee Name").Value = "*" & aweSh.Cell(rng.Row, "Employee Name").Value
Next rng
'--- Print the sum in the immediate window and verify ---
Debug.Print "Verify filter displays Task-127 & Task-145 and that their Revenue sum equals: " & _
WorksheetFunction.Sum(aweSh.DataColumns("Revenue").SpecialCells(xlCellTypeVisible))
End Function
Search Using Find - Behind the scenes, AWE_Sheet.FindCells uses Excel's FindNext and FindPrevious to create and returns an array of found cells or ranges. Simply loop through the array to retrieve and update cells.
Pros: Fast performance, easy to implement.
Cons: Lacks the ability to create complex searches
Public Function SearchUsingFind()
Dim vTaskID as Variant, rng As Variant, AWEsh As New AWE_Sheet: AWEsh.Initialize ActiveSheet, 3
'--- loop through rows that were returned from FindCells ---
For Each vTaskID In Array("Task-127", "Task-145")
For Each rng In AWEsh.FindCells(CStr(vTaskID), "TaskID")
If Not rng Is Nothing Then
AWEsh.Cell(rng.Row, "Rate").Value = 227.5
AWEsh.Cell(rng.Row, "Revenue").Value = 227.5 * AWEsh.Cell(rng.Row, "Hours").Value
AWEsh.Cell(rng.Row, "Employee Name") = "*" & AWEsh.Cell(rng.Row, "Employee Name")
End If
Next rng
Next vTaskID
End Function
Note: Use the astrisk symbol(*) as a wild card when searching for text. The asterisk represents one or more characters. For example "Mi*" will find ranges beginning with "Mi". "*ik* will find ranges containing "ik", "*ke" will find ranges ending with "ke". All of these searches will find ranges with the name, "Mike". As such, AWEsh.FindCells("Task-14*", "TaskID") will return all cells in the "TaskID" column that start with "Task-14".
Search Using a Multi-Column Key - Create a multi-column key to find data based on values in multiple columns
Pros: Fast performance even when searching for data in multiple columns. Ability to add data to the key.
Cons: Lacks the ability to search based on complex criteria such as looping through rows or using filters. Unique keys are required to a specific row. There is no next/previous features but you can iterate after the first found row to other rows if your data is sorted correctly.
Public Function SearchUsingMultiColKey()
Dim aweSh As New AWE_Sheet: aweSh.Initialize TableOrSheetNmOrObj:=ActiveSheet, HdrRowNb:=3
'--- Create & searchfor, multi-column, row keys ---
aweSh.CreateRowKeys "Employee Name", "Date"
Debug.Print "Name-0001 1/7/2021 Row:" & aweSh.FindRowKey("Name-0001", CDate("1/7/2021"))
'--- If the key isn't found then append it to the end of the sheet and the RowKeys array ---
If aweSh.FindRowKey("Name-0001", CDate("1/1/2022")) = -1 Then _
aweSh.AppendRowKey "Name-0001", CDate("1/1/2022")
Debug.Print "Appended Name-0001 1/1/2022 Row:" & aweSh.FindRowKey("Name-0001", CDate("1/1/2022"))
End Function
Search Looping Through Rows - Loop through all rows on the sheet looking for and updating values.
Pros: Implement complex search criteria.
Cons: Slower performance.
Public Function SearchUsingLoop()
Dim sTaskID As String, rng As Range, AWEsh As New AWE_Sheet: AWEsh.Initialize ActiveSheet, 3
'--- Loop through all rows ---"
For Each rng In AWEsh.DataBodyRange().Rows
sTaskID = AWEsh.Cell(rng.Row, "TaskID")
If sTaskID = "Task-127" Or sTaskID = "Task-145" Then
AWEsh.Cell(rng.Row, "Rate").Value = 227.5
AWEsh.Cell(rng.Row, "Revenue").Value = 227.5 * AWEsh.Cell(rng.Row, "Hours").Value
AWEsh.Cell(rng.Row, "Employee Name") = "*" & AWEsh.Cell(rng.Row, "Employee Name")
End If
Next rng
End Function
Open, Read, and Updating Shared and Web Enabled (Browser/Teams) Workbooks - If you work in an enterprise environment, you will undoubtedly need to automate a shared workbook located in Teams, SharePoint... Columns and Rows will be protected, filtered...
Before you start automating, realize the limitations of Excel Macros in Shared Workbooks and that Excel Macros can NOT be run from a web enabled Workbook. There are workarounds, a macro can run from an Excel Workbook opened as a Desktop App even if the Workbook is shared or web enabled by others.
Two primary work around options for automating shared workbooks:
- Open a Shared Workbook in ReadOnly Mode and copy the desired sheet(s) to a macro enabled, non-shared workbook. Then perform your queries.
- Pros: Allows the Shared Workbook to be non-Macro Enabled. Remove shared workbook limitations. Manipulate unprotected sheets...
- Cons: Unable to update the shared Workbook.
- Open a the workbook as a Desktop App and work within the limitations of a Shared Workbook. My preference is to place macros in an entirely different Workbook (xlxm, Macro-enabled Workbook) altogether that then update the Shared Workbook (xlsx, non-Macro-enabled Workbook).
- Pros: Update the Workbook while it is being shared by others
- Cons: You are constricted to Shared Workbook limitations. Additionally you may need to quickly unprotect the sheet to access protected ranges, change the filter...
The below Code provides a brief implementation of these options.
Function UpdateSharedWorkbooks()
Const SharePointFileNm As String = https://YourDomain/Sites/SiteName/.../...
Dim shRemote As New AWE_Sheet, shLocal As New AWE_Sheet, oProtect As Object
'-------------------------------------------------------------------------------------------------
' Option 1 - Copy a remote Workbook's sheet to a local Workbook. Close the remote Workbook. ---
' Then manipulate the local Workbook. ---
'-------------------------------------------------------------------------------------------------
'--- Open the remote workbook ---
shRemote.Initialize "SheetName", 3, SharePointFileNm, True
'--- Turn off error handling and delete the local sheet if it exists ---
On Error Resume Next
If Not ThisWorkbook.Sheets("SheetName") Is Nothing Then ThisWorkbook.Sheets("SheetName").Delete
On Error GoTo 0
'--- Copy the remote worksheet to the local workbook ---
shRemote.Sheet.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'--- Close the remote workbook ---
shRemote.Workbook.Close
'--- Initialize the worksheet, unprotect it, clear and set filters... ---
shLocal.Initialize "SheetName", 3
shLocal.UnprotectSheet "1234"
shLocal.ClearSheetFilters
'--- Manipulate data here. Use any of the above examples ---
'----------------------------------------------------------------------------------
' Option 2 - Open the remote sheet, query and directly update ranges or cells ---
'----------------------------------------------------------------------------------
'--- Open the remote workbook ---
shRemote.Initialize "SheetName", 3, SharePointFileNm, True
'--- Capture protection parameters and unprotect the sheet ---
Set oProtect = shRemote.UnprotectSheet("password")
'--- Quickly perform queries and updates here (use any of the above examples) ---
shRemote.ClearSheetFilters ' and so on...
'--- Re-protect the workbook ---
shRemote.ProtectSheet (oProtect)
'--- If the workbook is being shared, then accept all changes on the sheet ---
If shRemote.Workbook.MultiUserEditing = True Then
shRemote.Workbook.AcceptAllChanges where:=shRemote.Sheet.name
End If
'--- Turn off file prompts, save, and close the workbook ---
Application.DisplayAlerts = False
shRemote.Workbook.Save
shRemote.Workbook.Close
Application.DisplayAlerts = True
End Function
Note, there are two workarounds options for updating protected Workbooks:
- Unprotect and update the Workbook when everyone has left for the day. This is good for long end of day processing.
- Open the Shared Workbook, unprotect it, quickly make your changes, re-protect the Shared workbook. This works only for quick processing.
Create Dummy Data - Create thousands of rows of dummy data to test with. Steps: 1) Implement the AWE_Sheet class in your workbook (see the below section called Implementation). 2) Create a worksheet called "Timecard" that has the following column header names on row three: Employee Name, Date, Week, TaskID, Task Desc, Hours, Rate, Revenue, and Email Address. 3) Finally, copy, paste and run the below code along with any of the above examples in your worksheet's VBA editor.
Note: AWE_Array provides an alternate way to create upto 100,000 rows of dummy data in under 3 seconds.
Function Create100KRows()
Dim dt As Date, iNm As Long, sNm As String, iRndm As Long, iHr As Long, iTtlHrs As Long
Dim iRow As Long, iHdrRow As Long, iMaxRows As Long: iHdrRow = 3: iMaxRows = 100000
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Timecard")
'--- Turn ScreenUpdating Off, Clear filters, delete used rows, create range ---
Application.ScreenUpdating = False
If ws.FilterMode = True Then ws.ShowAllData
ws.Range(ws.Cells(iHdrRow + 1, 1), ws.Cells(ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1, 1)).EntireRow.Delete
Dim rng As Range: Set rng = ws.Range(ws.Cells(iHdrRow + 1, 1), ws.Cells(iHdrRow + 1 + iMaxRows, 9))
'--- Create AWE_Array Object ---
Dim AWEArr As New AWE_Array: AWEArr.Initialize rng:=rng, HdrRowNb:=iHdrRow
'--- Iterate through all rows, populating names, dates, tasks... with ficticious data ---
Dim iTmr As Single: iTmr = Timer
iRow = AWEArr.FirstDataRow: Do While iRow <= iMaxRows
iNm = iNm + 1: sNm = "Name-" & Format(CStr(iNm), "0000")
'--- Add weekdays for an entire year ---
For dt = CDate("1/1/2021") To CDate("12/31/2021")
If Weekday(dt, vbMonday) > 5 Then
iTtlHrs = 0
Do While iTtlHrs < 8
'--- Update Employee Name thru Week Columns ---
AWEArr.Cell(iRow, Cols.EmpNm) = sNm
AWEArr.Cell(iRow, Cols.EmailAddr) = sNm & "@Domain.com"
AWEArr.Cell(iRow, Cols.dates) = dt
AWEArr.Cell(iRow, Cols.Week) = WorksheetFunction.WeekNum(dt)
'--- Create a random number from 1 to 100 for the TaskID, Task Desc, and Rate ---
iRndm = Int((100 * Rnd) + 1) + 100
AWEArr.Cell(iRow, Cols.TaskID) = "Task-" & iRndm
AWEArr.Cell(iRow, Cols.TaskDesc) = "Desc for Task-" & iRndm
AWEArr.Cell(iRow, Cols.Rate) = iRndm
'--- Create random hours from 1 to 8. Ensure only 8 hours are worked in a day ---
iHr = Int((8 * Rnd) + 1): If iTtlHrs + iHr > 8 Then iHr = 8 - iTtlHrs
iTtlHrs = iTtlHrs + iHr
AWEArr.Cell(iRow, Cols.hours) = iHr
'--- Update Revenue ---
AWEArr.Cell(iRow, Cols.Revenue) = iHr * iRndm
'--- Increment iRow and display progress on the StatusBar every 1000 rows---
iRow = iRow + 1: If iRow > (iMaxRows + 1) Then GoTo Exit_Create100KRows
If iRow Mod 10000 = 0 Then
Application.StatusBar = Int((iRow / iMaxRows) * 100) & "% Complete"
End If
Loop
End If
Next dt
Loop
Exit_Create100KRows:
'--- Write the array to the sheet ---
AWEArr.WriteArray
Application.ScreenUpdating = True
MsgBox "Created " & iMaxRows & " rows in " & _
Format((Timer - iTmr) / 86400, "hh:mm:ss") & " seconds."
End Function
Add comment
Comments