Option Explicit
'====================================================
'Module name suggestion: modFileAndWorkbookUtils
' KumarCode.blogspot.com
' VBA Utility Functions for Files, Folders & Workbooks
' Author: @KumarAnalytics (Telegram)
'====================================================
'----------------------------------------------------
' Get last used Row or Column in a worksheet
'
' Usage:
' fn_LastRowColumn Activesheet, "R"
' fn_LastRowColumn ShtObj, "C"
'----------------------------------------------------
Public Function fn_LastRowColumn(sht As Worksheet, RowColumn As String) As Long
Select Case LCase(Left(RowColumn, 1)) 'If they put in 'row' or column instead of 'r' or 'c'.
Case "c"
fn_LastRowColumn = sht.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Case "r"
fn_LastRowColumn = sht.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Case Else
fn_LastRowColumn = 1
End Select
End Function
'-------------------------------------------------------
' Function to find any values in the Range (Row or Column)
'----------------------------------------------------
Public Function fn_FindInRange(sht As Worksheet, inputVal As String, atPosition As Long, rowOrColumn As String) As Range
'PURPOSE: Find a value in a specific row or column safely
'If not found, returns Nothing (no error)
Dim findRng As Range
rowOrColumn = LCase(Trim(rowOrColumn))
On Error Resume Next ' safety in case of invalid references
With sht
Select Case Left(rowOrColumn, 1)
Case "c" ' Search in column
Set findRng = .Columns(atPosition).Find(what:=inputVal, LookAt:=xlWhole)
Case "r" ' Search in row
Set findRng = .Rows(atPosition).Find(what:=inputVal, LookAt:=xlWhole)
Case Else
Set findRng = Nothing
End Select
End With
'Return Nothing if not found
If Not findRng Is Nothing Then
Set fn_FindInRange = findRng
Else
Set fn_FindInRange = Nothing
End If
On Error GoTo 0
End Function
'-------Test Case
Sub test_fn_FindInRange()
Dim foundCell As Range
Set foundCell = fn_FindInRange(Sheet1, "Total", 1, "C")
If Not foundCell Is Nothing Then
MsgBox "Found at " & foundCell.Address
Else
MsgBox "Value not found"
End If
'if you want to see the row then use
MsgBox foundCell.Row
'if you want to see the column then use
MsgBox foundCell.Column
'and so many things can do as your need.....
End Sub
'----------------------------------------------------
' Check if File or Folder exists
' Check if file exists
'----------------------------------------------------
Public Function fn_FileExists(FilePath As String, Optional FindFolders As Boolean = False) As Boolean
Dim Attr As Long
Attr = vbReadOnly Or vbHidden Or vbSystem
If FindFolders Then
Attr = Attr Or vbDirectory
Else
Do While Right$(FilePath, 1) = "\"
FilePath = Left$(FilePath, Len(FilePath) - 1)
Loop
End If
On Error Resume Next
fn_FileExists = (Len(Dir(FilePath, Attr)) > 0)
On Error GoTo 0
End Function
'----------------------------------------------------
' Check if folder exists
'----------------------------------------------------
Public Function fn_FolderExists(FolderPath As String) As Boolean
On Error Resume Next
fn_FolderExists = (Len(Dir(FolderPath, vbDirectory)) > 0)
On Error GoTo 0
End Function
'----------------------------------------------------
' Get file name from full path
'----------------------------------------------------
Public Function fn_GetFileName(FullPath As String) As String
fn_GetFileName = Mid$(FullPath, InStrRev(FullPath, "\") + 1)
End Function
'----------------------------------------------------
' Get file name without extension
'----------------------------------------------------
Public Function fn_GetFileNameNoExt(FullPath As String) As String
fn_GetFileNameNoExt = Split(fn_GetFileName(FullPath), ".")(0)
End Function
'----------------------------------------------------
' Get folder path from full file path
'----------------------------------------------------
Public Function fn_GetFilePath(FullPath As String) As String
fn_GetFilePath = Left(FullPath, InStrRev(FullPath, "\"))
End Function
'----------------------------------------------------
' Ensure trailing slash in folder path
'----------------------------------------------------
Public Function fn_AddTrailingSlash(PathIn As String) As String
If Len(PathIn) > 0 Then
If Right(PathIn, 1) <> "\" Then
fn_AddTrailingSlash = PathIn & "\"
Else
fn_AddTrailingSlash = PathIn
End If
End If
End Function
'----------------------------------------------------
' Check if worksheet exists
'----------------------------------------------------
Public Function fn_WorksheetExists(SheetName As String, Optional wb As Workbook) As Boolean
Dim ws As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set ws = wb.Worksheets(SheetName)
fn_WorksheetExists = Not ws Is Nothing
On Error GoTo 0
End Function
'----------------------------------------------------
' List all files in a folder (Immediate Window)
'----------------------------------------------------
Public Sub fn_ListFiles(FolderPath As String)
Dim FileName As String
FileName = Dir(FolderPath)
Do While FileName <> ""
Debug.Print FolderPath & FileName
FileName = Dir
Loop
End Sub
'----------------------------------------------------
' Check if workbook is open (Direct)
'----------------------------------------------------
Public Function fn_IsWorkbookOpen(WorkbookName As String) As Boolean
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(WorkbookName)
fn_IsWorkbookOpen = Not wb Is Nothing
On Error GoTo 0
End Function
'----------------------------------------------------
' Check if workbook is open (Loop method)
'----------------------------------------------------
Public Function fn_IsWorkbookOpenByLoop(WorkbookName As String) As Boolean
Dim i As Long
For i = 1 To Workbooks.Count
If Workbooks(i).Name = WorkbookName Then
fn_IsWorkbookOpenByLoop = True
Exit Function
End If
Next i
End Function
'----------------------------------------------------
' Close workbook safely
'----------------------------------------------------
Public Function fn_CloseWorkbook(WorkbookName As String) As Boolean
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(WorkbookName)
If Not wb Is Nothing Then
wb.Close SaveChanges:=False
fn_CloseWorkbook = True
End If
On Error GoTo 0
End Function
No comments:
Post a Comment