Thursday, June 11, 2020

Generate filename with date time stamp and separate file name and path from given file path

Hi folks,

many times we need to create the dummy or new file or report file with date timestamp appending to file name. Also, from the given file path we need to separate the file name and file path then definitely this post might help you.

Public Function AddResultTestdatafile(strFilePath)
   
    Workbooks.Add Template:=strFilePath
    strNewFileTempName = getFName(strFilePath)
    strTestFileNameval = Split(strNewFileTempName, ".")
    strNewFilePath = getPath(strFilePath)
    'to generate file name appending datetime stamp
    strNewTestFileName = strTestFileNameval(0) & "_" & "DummyData" & "_" & Year(Date) & Right("00" & Month(Date), 2) & Right("00" & Day(Date), 2) & Right("00" & Hour(Time), 2) & Right("00" & Minute(Time), 2) & Right("00" & Second(Time), 2) & ".xlsx"
    ActiveWorkbook.SaveAs _
        Filename:=strNewFilePath & strNewTestFileName
    ResultDummyFilename = strNewFilePath & strNewTestFileName
    AddResultTestdatafile = ResultDummyFilename
   
End Function

'to get the path from given file path
Function getPath(pathfile) As String: getPath = Left(pathfile, InStrRev(pathfile, "\")): End Function

'to get the file name from given file path
Function getFName(pathfile) As String: getFName = Mid(pathfile, InStrRev(pathfile, "\") + 1): End Function

Cheers.
TJ

Thursday, June 4, 2020

Find duplicate value in column along with row number using vba

Hi Folks,

In sheet, particular column if we need to find the duplicate value for some text and on which row that text appears, we can find it using below logic. Also, here the column name can also be dynamic on sheet, so this will find it based on column index in given range.

Sub fnFindDupValRowNoInCol()
Dim shRead As Worksheet
Set shRead = ThisWorkbook.Sheets("WorksheetDemo")
strSearchNameTxt = "Priya"
'function to get the column index based on name
ColNameIndexrST = fnGetColIndex(shRead, "Name")
MsgBox "Name column index is " & ColNameIndexrST
'function to find row number for given search text

Dim iWriteSTNameRowNoFlag As String: iWriteSTNameRowNoFlag = GetshWriteNametextRow(shRead, strSearchNameTxt, ColNameIndexrST)
iWriteSTNameRowN0RecVal = Split(iWriteSTNameRowNoFlag, ";")
                If UBound(iWriteSTNameRowN0RecVal) > 1 Then
                    MsgBox "Mulitple value found"
                    MsgBox "Total number of duplicate value is " & UBound(iWriteSTNameRowN0RecVal)
                    flgmultiRec = True
                Else
                    MsgBox "multiple value not found"
                    flgmultiRec = False
                    iWriteSTNameRowNo = iWriteSTNameRowN0RecVal(1)
                End If
End Sub
Public Function fnGetColIndex(WST As Worksheet, strSearchCol)
        Set findrng = WST.Range("1:1")
        ColIndex = findrng.Find(strSearchCol, LookIn:=xlValues, LookAt:=xlWhole).Column
        fnGetColIndex = ColIndex
End Function

Public Function GetshWriteNametextRow(WST As Worksheet, strSearchTxt, strColIndex)
GetshWriteNametextRow = 0
WST.Activate
'code to find last used rows
shWritelRows = WST.Cells(Rows.Count, strColIndex).End(xlUp).Row
'code to give Range along with column index instead A1 kind of
'Range(A1) is same as Range(cells(1,1)
Set Rng1 = WST.Range(WST.Cells(1, strColIndex), WST.Cells(shWritelRows, strColIndex))
flgMoreMatchCnt = False
Dim matchIndexVal As String
rowval = 0
With ActiveSheet
    Set Rng = .UsedRange.Find(strSearchTxt)
    If Not Rng Is Nothing Then
        firstAddress = Rng.Address
        Do
            'c.Value = 5
            Row = Rng.Row
            MsgBox " Search value found at row " & Row
            rowval = rowval & ";" & Row
            Set Rng = .UsedRange.FindNext(Rng)
        If Rng Is Nothing Then
            GoTo DoneFinding
        End If
        Loop While Rng.Address <> firstAddress
      End If
DoneFinding:

End With
GetshWriteNametextRow = rowval
End Function

Cheers.
TJ

Thursday, May 28, 2020

Getting row index for particular given string value of string

Hi Folks,

Sometimes, you need to find the row index of particular row in sheet based on fixed value string and need to operate some operation based on that row like adding and delete row above and below that string value row, this code might help you.

strSearchTxt ="This is search row text for index find of this row"
Dim iTextRow As Long: iTextRow = GetTextRow(strSearchTxt )

Public Function GetTextRow(strSearchTxt)
GetTextRow = 0
With ActiveSheet
    Set Rng = .UsedRange.Find(strSearchTxt)
    If Not (Rng Is Nothing) Then GetTextRow = Rng.Row
End With
End Function

Cheers.

Get Column index based on column name using vba

Hi folks,

If you need to find the column index based on column name, when your column sequence is not fixed in your sheet, please find below code which might helpful to you.

Code sample 1:
 Set findrng = wST.Range("1:1")
 ColNameIndex = findrng.Find("searchcolname").Column

Code sample 2:
strnameindex = wST.Match("searchcolname",wST.Range("1:1"), 0)

Code sample 3:
Function GetHeaderColumn(shRead As Worksheet, header As String) As Integer
    Dim headers As Range
    Set headers = shRead.Range("1:1")
    GetHeaderColumn = IIf(IsNumeric(Application.Match(header, headers, 0)), Application.Match(header, headers, 0), 0)
End Function

Cheers.
TJ.