VBA Method for Age Calculation :

Function DOB(rng As Range)
DOB = VBA.Format(VBA.DateDiff("d", rng, Date), "yy mm dd")
End Function

Text to column

Hi,
if you are finding a code such like Text to Column . it can help you


    Sub TextToColumn()
        Dim ArrList
        Dim rngCell As Range
        Dim strDelimeter    As String
        strDelimeter = Application.InputBox("Please Provide a Delimeter", "Text To Column")
        For Each rngCell In Selection
            ArrList = Split(rngCell.Value, strDelimeter)
            If WorksheetFunction.CountA(rngCell.Offset(, 1).Resize(1, UBound(ArrList) + 1)) > 1 Then
                If MsgBox("Some data can be replaced ,Do you want to Continue", vbYesNo) = vbYes Then
                    rngCell.Offset(, 1).Resize(1, UBound(ArrList) + 1).Value = ArrList
                End If
                Else
                rngCell.Offset(, 1).Resize(1, UBound(ArrList) + 1).Value = (ArrList)
                rngCell.Offset(, 1).Resize(1, UBound(ArrList) + 1).Value = rngCell.Offset(, 1).Resize(1, UBound(ArrList) + 1).Value
            End If
        Next
    End Sub

Hope you will post an excellent solution here

welcome  my followers to this quiz , you need to write a function to get the file extension through either a VBA function or inbuilt excel function

FIleName	.
Book1.Doc
Book.book1.xls
book.book1.book1.xlsx
book.book.book.book1.xlsm

Hope you will post a excellent function :)

Age Calculation :

If Current Date in A1 and Date of Birth in B2 then Put this Function to Calculate Age:

=DATEDIF(B2,B1,"Y")&" Year "&DATEDIF(B2,B1,"YM")&" Month "&DATEDIF(B2,B1,"MD")&" Days"

Unique List by Function

See the attached File :

http://www.sendspace.com/file/ld5mqw

Get Last Populated Cell Address

Paste it on worksheet Change the Range Address and Press Shift+Ctrl+Enter

=IFERROR(ADDRESS(MAX(IF(LEN(A1:I36)>0,ROW(A1:I36)),0),MAX(IF(LEN(INDIRECT(MAX(IF(LEN(A1:I36)>0,ROW(A1:I36)),0)&":"&MAX(IF(LEN(A1:I36)>0,ROW(A1:I36)),0)))>0,COLUMN(INDIRECT(MAX(IF(LEN(A1:I36)>0,ROW(A1:I36)),0)&":"&MAX(IF(LEN(A1:I36),ROW(A1:I36)),0)))))),0)

Hide and Show

Sub HideAll()
    With Application
        .DisplayFormulaBar = False
        .DisplayScrollBars = False
        .DisplayStatusBar = False
    End With
    With ActiveWindow
        .DisplayGridlines = False
        .DisplayHeadings = False
        .DisplayHorizontalScrollBar = False
        .DisplayVerticalScrollBar = False
        .DisplayWorkbookTabs = False
    End With
End Sub

Sub ShowALl()
    With Application
        .DisplayFormulaBar = True
        .DisplayScrollBars = True
        .DisplayStatusBar = True
    End With
    With ActiveWindow
        .DisplayGridlines = True
        .DisplayHeadings = True
        .DisplayHorizontalScrollBar = True
        .DisplayVerticalScrollBar = True
        .DisplayWorkbookTabs = True
    End With
End Sub

Assigning Value

It's a best way to Assign Multiple values to Range By Array


Sub AssignValues()
Range("A1:D1").Value = Array("Sr.No", "Name", "Contact", "Address")
End Sub

Delete Multiple worksheets

You can use this code to delete multiple sheet without loop

Sub DeleteSheet()

Application.DisplayAlerts = False

    Worksheets(Array("Sheet1", "Sheet1", "Sheet1")).Delete

Application.DisplayAlerts = True

End Sub

JOIN

its a method to concatenation values in a string variable , you can use this trick to avoid a Loop for this purpose.

Sub MakeString()

    Dim strSting As String

    strSting = Join(Application.Transpose(Selection), ",")

    Debug.Print strSting

End Sub

Evaluate :

EVALUATE  is method in VBA which can evaluate any Function of Excel in VBA and can return the value in a variable.

To make your code faster you can use this EVALUATE trick in VBA to avoide extra looping .. it can work  till 255 cells


Like if you want to Change Case of some Text on selection you can use this command in vba.

selection=evaluate("=if(len(" & selection.address &")>0,upper(" & selection.address &")," & selection.address &")")


if you want any Calculation with cells :

selection= Evaluate( selection.address &"/1000")