Nick's picture

XLA routines: EE_DateFileName

EE_DateFileName if a function that creates a date / time stamped file name in yyyymmdd format so that it can be sorted in Explorer
Function EE_DateFileName(strFileName As String, Optional varFileDate As Variant, Optional blnAddTime As Boolean) As String
'- takes a file name
' FileDate As Variant
' AddTime As Boolean
'- if date is missing, it appends today's date formatted as: '_yyyymmdd'
'- if AddTime is true, add 'hhmmss' of Now()
'- returns file name with appended date stamping
    Dim strNewFileName As String
Nick's picture

XLA routines: EE_ExportRangeToCSV

EE_ExportRangeToCSV creates a csv file from a range of data, and replaces errors.
Function EE_ExportRangeToCSV(strCSVfileName As String, rngExport As range, Optional blnDispMsg As Boolean = False) As Boolean
'-Takes a csv file name
'-deletes existing
'- converts all dates or times to longs - not implemented
'- exports CSV
' - if the cell contains an error (eg: #Value), it writes 'ERROR'
'- restores date time formatting - not implemented
'- returns True if success
    Dim wbkCSV              As Workbook
    Dim strCSVfullFilePath  As String
Nick's picture

XLA routines: EE_CheckPaths

EE_CheckPaths takes a range containing file paths, and checks to see if they all exist. - very useful at the start of a routine that depends on files existing. - check the paths and exit if they don't exist
Function EE_CheckPaths(rngPaths As range, Optional blnDispMissingMsg As Boolean = True) As Boolean
'- takes a range of cells containing file paths / folders.
'- checks if they exist
'- returns false if any 1 doesn't exist
'- displays messagebox with list of missing paths
    Dim strMissingPaths As String
    Dim rngEachPath As range
Nick's picture

XLA routines: EE_DeleteFile

EE_DeleteFile deletes a file if it exists.
Sub EE_DeleteFile(strFilePath As String, Optional blnShowMsg As Boolean = False)
'- takes file path
'- deletes file
'- does not error if file does not exist
'- does error if file is locked
'    for updates on this sub routine

    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(strFilePath) Then
            On Error Resume Next
                .deletefile strFilePath
                If Err.Number <> 0 And blnShowMsg = True Then
                    MsgBox Err.D
Nick's picture

XLA routines: EE_Copy

EE_Copy is one of the most used EE sub routines. Specify the source, and the top left of the target, and EE_Copy will copy the data over.
Nick's picture

XLA routines: EE_TableRemoveHeadings

EE_TableRemoveHeadings is a function that takes a table of data + headings and returns only the data
Function EE_TableRemoveHeadings(rngTable As range) As range
'- Takes an EE_table range
'- removes the headings
'- returns a range
'    for updates on this function

    Set EE_TableRemoveHeadings = Intersect(rngTable, rngTable.Offset(1))
End Function
Nick's picture

XLA routines: EE_TableFirstRowRange

EE_TableFirstRowRange is a simple function to return the first row of a table of data (the Headings)
Function EE_TableFirstRowRange(rngTable As range) As range
'- Takes an EE_Table Range
'- returns a range around the 1st Row in the table
'    for updates on this function

    Set EE_TableFirstRowRange = rngTable.Rows(1)
End Function
Nick's picture

XLA routines: EE_Find

The problem with Excel's "Find" routine is that it does not reset the Find criteria, so that when you use CTRL+F on the worksheet, you have to reset all the params. EE_Find gets around this by resetting the criteria. Returns a range object or nothing
Function EE_Find(strFind As String, rngRangeToFindIn As range) As range
'- takes a string, RangeToLookIn
'- returns a range of the first cell containing the string
'- uses .Find method, and looks for exact match, in whole cell
'- returns the 'exact match' checkbox back to unchecked

Nick's picture

XLA routines: EE_TableHeadingCol

EE_TableHeadingCol is a function that returns the column of a heading...
Nick's picture

XLA routines: EE_FilterAndRemove

EE_FilterAndRemove is a hugely useful VBA routine that uses sorting to remove large amounts of data from a table. Specify your table of data, the heading name, and the criteria. - designed to work well with vast amounts of data
Sub EE_FilterAndRemove(rngTable As range, strHeading As String, strCriteria As String)
    Dim rngTblData      As range
    Dim rngSortData     As range
    Dim intHeadCol      As Integer
'    for updates on this sub routine
    Set rngTblData = Intersect(rngTable, rngTable.Offset(1))
Nick's picture

XLA routines: EE_HideSheets

EE_HideSheets is a sub routine that hides any sheets that are not in the range of sheet names specified, or hides everything in the range if blnReverseSelection is true
Sub EE_HideSheets(ArrayOrRange, Optional blnReverseSelection As Boolean = False)
'> - takes an array or range
'> - Hide any sheets that are/not contained in the array\range
    Dim arr
    Dim intWksCount         As Integer
    Dim blnDelete           As Boolean
    Dim blnDelete2          As Boolean
    Dim wbk                 As Workbook
    Dim intShtAdded         As Integer
    Dim intShtAdded2        As I
Nick's picture

XLA routines: EE_ColorSheetTabs

EE_ColorSheetTabs is an easy sub that takes a range of coloured cells with sheet tab names in it. - colours the sheet tabs in accordance with the cell colour.
Sub EE_ColorSheetTabs(rngColor As range)
    Dim rngEach     As range
    Dim wbk         As Workbook
'    for updates on this sub routine
    Set wbk = ThisWorkbook
    For Each rngEach In rngColor
        On Error Resume Next
        wbk.Worksheets(rngEach.value).Tab.Color = rngEach.Interior.Color
        Err.Clear: On Error GoTo 0: On Error GoTo -1
Nick's picture

XLA routines: EE_SortTable

Sub routine that sorts a table using Excel 2007+ code. Needs to be extended to work with heading 2 and 3
Sub EE_SortTable(blnAscending As Boolean, wks As Worksheet, strFieldHeading As String)
'> - takes string of sheet name or wosksheet object, Heading1 string,
'> Ascending1 boolean...
Nick's picture

XLA routines: EE_AddCalculatedColumn

EE_AddCalculatedColumn is a hugely useful sub routine that adds a calculated column to your data set, and names it. - this saves writing the VBA to add a calculated column from your data set. Uses EE_GetLastPopulatedCell to find the last cell of the data
Sub EE_AddCalculatedColumn(rngColumn As range, strFormula As String, strNewHeading As String, Optional InChunksOf As Long)
    Dim rng As range
    With rngColumn
        Set rng = range(.Cells(2), .Cells(EE_GetLastPopulatedCell(rngColumn.Parent).
Nick's picture

XLA routines: EE_CloseOtherWorkbooks

Routine to close other workbooks - this saves setting variables and tracking open workbooks
Sub EE_CloseOtherWorkbooks(wbKeepOpen As Workbook)
'    for updates on this sub routine
' closes workbooks other than the workbook containing the code and another one specified
Dim wbk As Workbook
    On Error Resume Next
    For Each wbk In Application.Workbooks
        If wbk.Name <> ThisWorkbook.Name Then
            If Not wbKeepOpen Is Nothing Then
                If wbk.Name <> wbKeepOpen.Name Then
Nick's picture

XLA routines: EE_FileNameFromFilePath

Returns the file name from the file path
Function EE_FileNameFromFilePath(strFilePath As String) As String

    EE_FileNameFromFilePath = Mid(strFilePath, InStrRev(strFilePath, Application.PathSeparator) + 1)
End Function
Nick's picture

XLA routines: EE_HeadersCorrect

Often others deliver files to an application that need to have fixed col headers. Unfortunately, they often change them without telling you.
Nick's picture

XLA routines: EE_ApplyPivotDataFormatting

Takes a pivot table, and formats the pivot field based on a 2 col range
Sub EE_ApplyPivotDataFormatting(pt As PivotTable, FormattingRange As range)
'- takes a 2 col range, and applies the formatting specified in col 2 to the Data fields.
    Dim rngCell As range
    If FormattingRange.Rows.Count <> 2 Then Exit Sub
    For Each rngCell In FormattingRange.Rows
        pt.PivotFields(rngCell.Cells(, 1).value).NumberFormat = rngCell.Cells(, 2).value
    Next rngCell
    Set rngCell = Nothing
End Sub
Nick's picture

XLA routines: EE_SortTable2003Comp

Sort data using VBA in Excel.
Nick's picture

XLA routines: EE_GetLastPopulatedCell

Finds the last populated cell on a worksheet, or an empty cell representing the max row and max col.
Function EE_GetLastPopulatedCell(Optional wks As Worksheet) As Range
'-          Works how specialcells (lastCell)  SHOULD work
'-          Returns single cell range
    Dim lngCol      As Long
    Dim lngMaxRow   As Long
    Dim lngRow      As Long
    Dim lngMaxCol   As Long
' for updates on this function

    If wks Is Nothing Then
        Set wks = ActiveSheet
    End If
    If wks.UsedRange.Rows
Nick's picture

XLA routines: EE_Table

If you use Excel as a database, EE_Table will return the range object of your data.
Nick's picture

XLA routines: EE_DeleteTempSheets

EE_DeleteTempSheets is used when your routine creates temp sheets that need to be deleted at the end of the routine.
Nick's picture

XLA routines: EE_RearrangeSheetsAlphabetic

EE_RearrangeSheetsAlphabetic is useful to use at the end of your procedure when you have created sheets all over the place and want them rearraged alphabetically.
Nick's picture

XLA Routines: EE_ReplaceSheet

EE_ReplaceSheet is a useful routine that replaces a sheet, and does not error if the sheet does not exist meaning you can use the routine to create a new sheet.
Function EE_ReplaceSheet(strSheet As String) As Worksheet
    Dim wksNew              As Worksheet
    Dim wbk                 As Workbook
    Dim blnDisplayAlerts    As Boolean
    Set wbk = ActiveWorkbook
    On Error Resume Next
        Set wksNew = wbk.Worksheets.Add(after:=wbk.Worksheets(strSheet))
    Err.Clear: On Error GoTo 0: On Error GoTo -1
    If wksNew Is Nothing Then
        Set wksNe
Nick's picture

XLA Routines: EE_DeleteSheets

Following on from EE_DeleteSheet, here's a routine that deletes multiple sheets
Sub EE_DeleteSheets(ArrayOrRange)
    Dim blnDisplayAlerts    As Boolean
    Dim arr
    Dim wbk                 As Workbook
    Set wbk = ActiveWorkbook
    Select Case TypeName(ArrayOrRange)
        Case "Variant()", "String"
            arr = ArrayOrRange
        Case "Range"
            arr = Application.Transpose(ArrayOrRange.SpecialCells(xlCellTypeConstants))
Nick's picture

XLA routines: EE_DeleteSheet

Deleting a sheet using VBA is more work than it should be.
Nick's picture

XLA routines: EE_End

At the end of your code, it's good practise to turn events back on, enable alerts, and put calculation back to where it was. Here's the code to turn them on:
Public lngCalc As Long
Sub EE_End()
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.Calculation = lngCalc
End Sub
See here to turn them off at the start of your code: EE_Start
Nick's picture

XLA routines: EE_Start

At the start of your code, it's good practise to turn off events, disable alerts, and put calculation on manual. At the end of your routine, turn them back on. Here's the code to turn them off:
Public lngCalc As Long
Sub EE_Start()

    Application.EnableEvents = False
    Application.DisplayAlerts = False
    lngCalc = Application.Calculation
    Application.Calculation = xlCalculationManual
End Sub
See here to turn them back on: EE_End

Create Database in excel and ms access

Hi Team,

Please help me. I am working in vba last two years and now i got some development tool for my friend. He asked me to create employee database application in excel. so i decide to create in excel user form and database with ms access.

can store huge data in msaccess and excel form will be reliable. help me.

Venkat R

how to make expired date

i want to appear expire date in day.., question is "sheet2=mly or qly or sly or yly, sheet3=act_date, sheet4=expired date" i need to appear if sheet2=mly then add 30 days, and appear how many days remaining to expired in sheet4 automatically from today, and if sheet2=qly + 90 days, and appear how many days remaining to expired like that,,, and sly=180 days and yly=360 days, so how can i make this report,,,,

Syndicate content