Resources
  • Home
  • December-Chrono
  • Psalm136Personalized
  • ExcelResources
    • 99PublicFunctions
    • aDelimitedCodeTemplate
    • aCodeTemplate
    • aBetter_Code_Template
    • ApplyFormulaValue
    • ArrayPublic
    • ArrayMatchCopyRow
    • Capitalization
    • Colors
    • DataTypes
    • DeleteRows
    • Filter
    • FormatStandard
    • Forms
    • Grid
    • Headers
    • ImageScrape
    • InputBox
  • ExcelResources2
    • Like
    • List Review
    • MatchAndReturn
    • mod_Import
    • Numbers
    • PDF_Parse
    • RandomGenerator
    • iRe1
    • Rept
    • RelatedItemsLIst
    • RomanNumerals
    • SheetSplitter
    • Sort
    • Split Method
    • String_DataType
    • TabDelimited
    • Tab_InsertNew_or_ClearExisting
    • Unique_List
      • UniqueLIsts_FilterMethod
  • Excelresources_Files
    • FileLists
    • FileTextParse
    • Folders
  • excelresources_WebScrape
    • CreateList_1-Href_2-Jpg
    • TableData_Load_PlugPlay
    • CreateList_MultiPage_Image_Link
      • ImageDownload_WebLink_List
    • TableData_Load_ClassDiv
    • TableData_Load_ClassSpan
  • Houseboat Vacation
  • At the Foot of the King
  • Devotions
  • Mentoring
  • Inspirational Stories
    • Vacuum Lifting
  • Job Help
  • Resources
    • MS
    • Florida History
  • Contact
  • Heroscape
    • Fish
    • Playstation
  • You Tube Videos
  • House
    • Tiny Houses
    • Backyards
  • CampingResources
    • CampingLand
    • LED Throwies
  • Interesting
  • Recipes
  • Xbox
  • Skydiving
  • ReadingPlan-5Year
  • Desoto
  • BibleStudy
  • HurricaneIrma
  • Home
  • December-Chrono
  • Psalm136Personalized
  • ExcelResources
    • 99PublicFunctions
    • aDelimitedCodeTemplate
    • aCodeTemplate
    • aBetter_Code_Template
    • ApplyFormulaValue
    • ArrayPublic
    • ArrayMatchCopyRow
    • Capitalization
    • Colors
    • DataTypes
    • DeleteRows
    • Filter
    • FormatStandard
    • Forms
    • Grid
    • Headers
    • ImageScrape
    • InputBox
  • ExcelResources2
    • Like
    • List Review
    • MatchAndReturn
    • mod_Import
    • Numbers
    • PDF_Parse
    • RandomGenerator
    • iRe1
    • Rept
    • RelatedItemsLIst
    • RomanNumerals
    • SheetSplitter
    • Sort
    • Split Method
    • String_DataType
    • TabDelimited
    • Tab_InsertNew_or_ClearExisting
    • Unique_List
      • UniqueLIsts_FilterMethod
  • Excelresources_Files
    • FileLists
    • FileTextParse
    • Folders
  • excelresources_WebScrape
    • CreateList_1-Href_2-Jpg
    • TableData_Load_PlugPlay
    • CreateList_MultiPage_Image_Link
      • ImageDownload_WebLink_List
    • TableData_Load_ClassDiv
    • TableData_Load_ClassSpan
  • Houseboat Vacation
  • At the Foot of the King
  • Devotions
  • Mentoring
  • Inspirational Stories
    • Vacuum Lifting
  • Job Help
  • Resources
    • MS
    • Florida History
  • Contact
  • Heroscape
    • Fish
    • Playstation
  • You Tube Videos
  • House
    • Tiny Houses
    • Backyards
  • CampingResources
    • CampingLand
    • LED Throwies
  • Interesting
  • Recipes
  • Xbox
  • Skydiving
  • ReadingPlan-5Year
  • Desoto
  • BibleStudy
  • HurricaneIrma
Connect on Facebook

Personal Toolbox
* Wrap Headers [ApplyFormatWrappedHeaders_To_ActiveSheet]
* Last Row / Last Column [GetLastCell]
* Set Column Object based on Header [CheckHeader]
* Insert Tab (Rename) [InsertTabRename]
* Delimited Strings: Remove Dupes [DupeRemovalDelimited]
* Strings - Type (Blank/Numeric/Alpha/Mixed) [IdentifyStringType]
* Format (Standard) [FormatStandard]


[ApplyFormatWrappedHeaders_To_ActiveSheet]

Sub ApplyFormatWrappedHeaders_To_ActiveSheet()

FormatWrappedHeaders (ActiveSheet.Index)
MsgBox "Finished Reformatting with Wrapped Headers"

End Sub

[GetLastCell]

Function GetLastCell(myWs As Long) As String
Dim iRe1 As Long, iCe1 As Long, iLoop As Long, iTempR As Long, iTempC As Long
iRe1 = 0: iCe1 = 0

    iTempC = 0
    For iLoop = 1 To 300
        iTempC = Worksheets(myWs).Cells(iLoop, Columns.Count).End(xlToLeft).Column
       If iTempC > iCe1 Then
            iCe1 = iTempC
                iTempR = Worksheets(myWs).Cells(Rows.Count, iCe1).End(xlUp).Row
                If iTempR > iRe1 Then iRe1 = iTempR
        End If
    Next iLoop

    iTempR = 0
    For iLoop = 1 To 300
        iTempR = Worksheets(myWs).Cells(Rows.Count, iLoop).End(xlUp).Row
        If iTempR > iRe1 Then
            iRe1 = iTempR
                iTempC = Worksheets(myWs).Cells(iRe1, Columns.Count).End(xlToLeft).Column
                If iTempC > iCe1 Then iCe1 = iTempC
        End If
    Next iLoop

If iRe1 = 0 Then iRe1 = 1
If iCe1 = 0 Then iCe1 = 1
GetLastCell = Cells(iRe1, iCe1).Address
End Function

[CheckHeader]

Public Function CheckHeader(iMyText As String, iMyWs As Long, iMyRow As Long, iMyEndCol As Long) As Double
'----------------------------------------------------------------------------------------------------
'Defines Current Sheet then moves to desired sheet
'Loops through the columns in the defined Header Row checking for an exact match on defined String
'Returns a numeric value if String is found, 0 if not found.
'Selects the original tab that was active when Function was called
'----------------------------------------------------------------------------------------------------
'Example:(How to use function)
'If CheckHeader(Ws1, iHeader, iCe1, "Stripped") <> 0 Then iStripA = CheckHeader(Ws1, iHeader, iCe1, "Stripped")
'----------------------------------------------------------------------------------------------------
Dim iTempWorksheet As Long
iTempWorksheet = ActiveWorkbook.ActiveSheet.Index
Worksheets(iMyWs).Select

Dim iLoopCol As Long
CheckHeader = 0

For iLoopCol = 1 To iMyEndCol
    If UCase(Cells(iMyRow, iLoopCol)) = UCase(iMyText) Then
        CheckHeader = iLoopCol
        Exit For
    Else
    End If
Next iLoopCol
Worksheets(iTempWorksheet).Select
End Function

[InsertTabRename]

Public Function InsertTabRename(myNewName As String)
'----------------------------------------------------------------------------------------------------------
'Defines current tab
'Loops through all tabs in book, if a tab exists with the same name as the desired new tab, it deletes it.
'Adds a new tab to the end of the book, renames it using desired String(myNewName)
'Selects the original tab that was active when Function was called
'----------------------------------------------------------------------------------------------------------

Dim iCurrentWs As Long, iTabLoop As Long, sCurrentWs As String

If ActiveSheet.Name = myNewName Then Worksheets(1).Select
iCurrentWs = ActiveSheet.Index: sCurrentWs = ActiveSheet.Name


For iTabLoop = 1 To ActiveWorkbook.Worksheets.Count
    If Worksheets(iTabLoop).Name = myNewName Then
        Application.DisplayAlerts = False
        Worksheets(iTabLoop).Delete
        Application.DisplayAlerts = True
        Worksheets(sCurrentWs).Select
        Exit For
    End If
Next iTabLoop
'-------------------------------------------------------------------------
    'add new sheet: rename
    Sheets.Add after:=Worksheets(ActiveWorkbook.Worksheets.Count)
    ActiveSheet.Name = myNewName
'-------------------------------------------------------------------------

Worksheets(sCurrentWs).Select
End Function

[DupeRemovalDelimited]

Function DupeRemovalDelimited(myInputStr As Variant, myDelimiter As Variant) As String
Dim sTemp As String, sDelimiter As String, sAssembled As String
Dim aSplitMe As Variant, iLoop As Long

sTemp = myInputStr
sDelimiter = myDelimiter
sAssembled = ""

If sTemp = "" Then GoTo gNoDelimiterSkipReturnOriginalValue
If InStr(1, sTemp, sDelimiter, vbTextCompare) = 0 Then GoTo gNoDelimiterSkipReturnOriginalValue

'SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
    'Split String (Populate Public Array: Row1-Headers)
    aSplitMe = Split(sTemp, sDelimiter)

       'Load All non blank values into the Array (Header Position)
    For iLoop = LBound(aSplitMe) To UBound(aSplitMe)
    
        If InStr(1, sAssembled, aSplitMe(iLoop) & sDelimiter, vbTextCompare) > 0 Then GoTo gSkipLoopValueAlreadyExists
        sAssembled = sAssembled & LCase(aSplitMe(iLoop)) & sDelimiter
        'If aSplitMe(iLoop) <> "" Then                               'aHeaderDump(1, iLoop + 1) = aSplitMe(iLoop)
    
    
gSkipLoopValueAlreadyExists:
    Next iLoop
    GoTo gReturnFinalResult
'SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

gNoDelimiterSkipReturnOriginalValue:
sAssembled = sTemp
GoTo gReturnFinalResult

gReturnFinalResult:
If Right(sAssembled, 1) = sDelimiter Then sAssembled = Left(sAssembled, Len(sAssembled) - 1)
DupeRemovalDelimited = sAssembled

End Function

[IdentifyStringType]

Function IdentifyStringType(vMyInput As Variant) As String
Dim iLoop As Long, iLenPre As Long, iLenPost As Long, sTemp As String

    'Load the string and take a snapshot of the length
    sTemp = vMyInput
    iLenPre = Len(sTemp)
    
    'Skip the review process for 0 length strings
    If iLenPre = 0 Then GoTo gNoString
    
    'Loop through all 10 digits and remove them from the string
    For iLoop = 0 To 9
        sTemp = Replace(sTemp, iLoop, "", , , vbTextCompare)
    Next iLoop

    'Take a snapshot of the length AFTER replacement of numeric values
    iLenPost = Len(sTemp)
    
    'Mark "Numeric" if there are no Alpha Characters
    If iLenPost = 0 Then GoTo gAllNumbers
    
    'Mark "Alpha" if there are no Numeric Characters
    If iLenPre = iLenPost Then GoTo gAllAlpha
    
    'If it gets this far, the string is a mix of ALPHA + NUMERIC
    GoTo gMixed
    
'------------------------------------------------------------------------
gNoString:
IdentifyStringType = "Blank"
Exit Function
'------------------------------------------------------------------------
gAllNumbers:
IdentifyStringType = "Numeric"
Exit Function
'------------------------------------------------------------------------
gAllAlpha:
IdentifyStringType = "Alpha"
Exit Function
'------------------------------------------------------------------------
gMixed:
IdentifyStringType = "Mixed"
Exit Function
'------------------------------------------------------------------------
End Function

[FormatStandard]

Public Function FormatStandard(myTab As Long)
'-----------------------------------------------------------------------------------------
'Selects desired worksheet, applys formats and returns to current worksheet when finished
'Formatting Standards: Lock Headers, Apply Filters, Autofit, Remove WrapText
'-----------------------------------------------------------------------------------------
Dim iCurrentWs As Long
iCurrentWs = ActiveSheet.Index

'-------------------------------------------------------------------------
'Freeze Header, Fix Header Fields
    Sheets(myTab).Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    Application.CutCopyMode = False
    Cells.Select
    Selection.AutoFilter
'-------------------------------------------------------------------------
'Autofit columns
    Cells.Select
    Cells.EntireColumn.AutoFit

    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("A2").Select
'-------------------------------------------------------------------------
Worksheets(iCurrentWs).Select
End Function
Powered by Create your own unique website with customizable templates.
  • Home
  • December-Chrono
  • Psalm136Personalized
  • ExcelResources
    • 99PublicFunctions
    • aDelimitedCodeTemplate
    • aCodeTemplate
    • aBetter_Code_Template
    • ApplyFormulaValue
    • ArrayPublic
    • ArrayMatchCopyRow
    • Capitalization
    • Colors
    • DataTypes
    • DeleteRows
    • Filter
    • FormatStandard
    • Forms
    • Grid
    • Headers
    • ImageScrape
    • InputBox
  • ExcelResources2
    • Like
    • List Review
    • MatchAndReturn
    • mod_Import
    • Numbers
    • PDF_Parse
    • RandomGenerator
    • iRe1
    • Rept
    • RelatedItemsLIst
    • RomanNumerals
    • SheetSplitter
    • Sort
    • Split Method
    • String_DataType
    • TabDelimited
    • Tab_InsertNew_or_ClearExisting
    • Unique_List
      • UniqueLIsts_FilterMethod
  • Excelresources_Files
    • FileLists
    • FileTextParse
    • Folders
  • excelresources_WebScrape
    • CreateList_1-Href_2-Jpg
    • TableData_Load_PlugPlay
    • CreateList_MultiPage_Image_Link
      • ImageDownload_WebLink_List
    • TableData_Load_ClassDiv
    • TableData_Load_ClassSpan
  • Houseboat Vacation
  • At the Foot of the King
  • Devotions
  • Mentoring
  • Inspirational Stories
    • Vacuum Lifting
  • Job Help
  • Resources
    • MS
    • Florida History
  • Contact
  • Heroscape
    • Fish
    • Playstation
  • You Tube Videos
  • House
    • Tiny Houses
    • Backyards
  • CampingResources
    • CampingLand
    • LED Throwies
  • Interesting
  • Recipes
  • Xbox
  • Skydiving
  • ReadingPlan-5Year
  • Desoto
  • BibleStudy
  • HurricaneIrma