Protect & UnProtect Sheets

Sometimes we need to protect the working sheet from others from making changes. This can  easily be done by protecting the file with a password. If you are using Excel 2013, you can protect your sheet(s) by selecting 'Protect Sheet' from 'Review' menu. Alternatively if you want to protect or unprotect all the sheets in a workbook you can use the below VBA code. In myPassword variable string you can put your own password.

Sub ProtectAll()

Dim sh As Worksheet

Dim myPassword As String

myPassword = "password"

For Each sh In ActiveWorkbook.Worksheets

sh.Protect Password:=myPassword

Next sh

End Sub

---------------------------------------------

Sub UnprotectAll()

Dim sh As Worksheet

Dim myPassword As String

myPassword = "password"

For Each sh In ActiveWorkbook.Worksheets

sh.Unprotect Password:=myPassword

Next sh

End Sub

Numbers to Text

Another useful code for converting numbers to text:

'Attribute VB_Name = "SpellNumber"

Option Explicit

' Ivan Soto / Sunday 5 January 2014

Public Function SpellIntegerEn(ByVal dCandidate As Double) As String

    Dim dSign As Double

    Dim dCand As Double

    Dim dTemp As Double

    Dim sTemp As String

    dSign = VBA.Interaction.IIf(dCandidate < 0#, -1, VBA.Interaction.IIf(dCandidate > 0, 1, 0))

    dCand = dSign * VBA.Conversion.Fix(dCandidate)

    

    If dCand > 999999999999999# Then

        SpellIntegerEn = "Number to spell exceeds 999999999999999. Unable to spell it."

    ElseIf dCand < 1# Then ' zero, just say so

        SpellIntegerEn = "zero"

    Else

        ' from 1 to 999 billion, positions shown as 9's here: 999,xxx,xxx,xxx,xxx

        dTemp = VBA.Conversion.Fix(dCand / 1000000000000#)

        If dTemp > 0 Then

            sTemp = SpellZeroTo999(dTemp, "billion")

        End If

        ' thousands of millions, positions shown as 9's here: xxx,999,xxx,xxx,xxx

        dTemp = VBA.Conversion.Fix(FPremainder(dCand, 1000000000000#) / 1000000000#)

        If dTemp > 0 Then

            sTemp = sTemp & VBA.Interaction.IIf(sTemp = "", "", " ") & SpellZeroTo999(dTemp, "thousand")

        End If

        ' 1 to 999 of millions, positions shown as 9's here: xxx,xxx,999,xxx,xxx

        dTemp = VBA.Conversion.Fix(FPremainder(dCand, 1000000000#) / 1000000#)

        If dTemp > 0 Then

            sTemp = sTemp & VBA.Interaction.IIf(sTemp = "", "", " ") & SpellZeroTo999(dTemp, "")

        End If

        If VBA.Conversion.Fix(FPremainder(dCand, 1000000000000#) / 1000000#) > 0 Then

            sTemp = sTemp & VBA.Interaction.IIf(sTemp = "", "", " ") & "million"

        End If

        ' thousands positions shown as 9's here: xxx,xxx,xxx,999,xxx

        dTemp = VBA.Conversion.Fix(FPremainder(dCand, 1000000#) / 1000#)

        If dTemp > 0 Then

            sTemp = sTemp & VBA.Interaction.IIf(sTemp = "", "", " ") & SpellZeroTo999(dTemp, "thousand")

        End If

        ' the rightmost three positions shown as 9's here: xxx,xxx,xxx,xxx,999

        dTemp = FPremainder(dCand, 1000#)

        If dTemp > 0 Then

            sTemp = sTemp & VBA.Interaction.IIf(sTemp = "", "", " ") & SpellZeroTo999(dTemp, "")

        End If

        If dSign < 0 Then

            SpellIntegerEn = "minus " & sTemp

        Else

            SpellIntegerEn = sTemp

        End If

    End If

End Function

' Ivan Soto / Sunday 5 January 2014

Private Function SpellZeroTo999(ByVal dCandidate As Double, ByVal sSuffix As String)

    Dim sTemp As String

    If dCandidate > 0# And dCandidate < 1000# Then

        If dCandidate > 99# Then

            sTemp = SpellZeroToNineteen(VBA.Conversion.Fix(dCandidate / 100#)) & " hundred"

        End If

        If (dCandidate Mod 100#) > 19# Then

            sTemp = sTemp & VBA.Interaction.IIf(sTemp = "", "", " ") & Spell20To99(dCandidate Mod 100#)

        ElseIf (dCandidate Mod 100#) > 0# Then

            sTemp = sTemp & VBA.Interaction.IIf(sTemp = "", "", " ") & SpellZeroToNineteen(dCandidate Mod 100#)

        End If

        SpellZeroTo999 = sTemp & VBA.Interaction.IIf(sSuffix = "", "", " " & sSuffix)

    End If

End Function

' Ivan Soto / Sunday 5 January 2014

Private Function SpellZeroToNineteen(ByVal dCandidate As Double) As String

    ' dCandidate is assumed to be a non-negative integer

    If dCandidate < 1 Then

        SpellZeroToNineteen = "zero"

    ElseIf (dCandidate Mod 100#) < 20# Then

        SpellZeroToNineteen = VBA.Interaction.Choose((dCandidate Mod 100#) + 1, _

                            "", "one", "two", "three", "four", "five", _

                            "six", "seven", "eight", "nine", "ten", "eleven", _

                            "twelve", "thirteen", "fourteen", "fifteen", "sixteen", _

                            "seventeen", "eighteen", "nineteen")

    End If

End Function

' Ivan Soto / Sunday 5 January 2014

Private Function Spell20To99(ByVal dCandidate As Double) As String

    Dim dCand As Double

    Dim dUnits As Double

    Dim sTemp As String

    dCand = (dCandidate Mod 100#)

    If dCand > 19# Then

        dUnits = dCand Mod 10#

        sTemp = VBA.Interaction.Choose(VBA.Conversion.Fix(dCand / 10#), "", "twenty", "thirty", "forty", "fifty", _

                                                                        "sixty", "seventy", "eighty", "ninety")

        If dUnits > 0# Then sTemp = sTemp & "-" & SpellZeroToNineteen(dUnits)

    End If

    Spell20To99 = sTemp

End Function

' Ivan Soto / Sunday 5 January 2014

Private Function FPremainder(ByVal dCandidate As Double, ByVal dDivisor As Double) As Double

    Dim dX As Double

    dX = VBA.Conversion.Fix(dCandidate / dDivisor)

    FPremainder = dCandidate - (dX * dDivisor)

End Function

How to convert a numeric value into English words in Excel

Create the sample function Called SpellNumber

1. Start Microsoft Excel.
   
2. Press ALT+F11 to start the Visual Basic Editor.
   
3. On the Insert menu, click Module.
   
4. Type the following code into the module sheet.
   
5. Then you can use this function =SpellNumber(A1)

Option Explicit

'Main Function

Function SpellNumber(ByVal MyNumber)

    Dim Dollars, Cents, Temp

    Dim DecimalPlace, Count

    ReDim Place(9) As String

    Place(2) = " Thousand "

    Place(3) = " Million "

    Place(4) = " Billion "

    Place(5) = " Trillion "

    ' String representation of amount.

    MyNumber = Trim(Str(MyNumber))

    ' Position of decimal place 0 if none.

    DecimalPlace = InStr(MyNumber, ".")

    ' Convert cents and set MyNumber to dollar amount.

    If DecimalPlace > 0 Then

        Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _

                  "00", 2))

        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))

    End If

    Count = 1

    Do While MyNumber <> ""

        Temp = GetHundreds(Right(MyNumber, 3))

        If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars

        If Len(MyNumber) > 3 Then

            MyNumber = Left(MyNumber, Len(MyNumber) - 3)

        Else

            MyNumber = ""

        End If

        Count = Count + 1

    Loop

    Select Case Dollars

        Case ""

            Dollars = "No Dollars"

        Case "One"

            Dollars = "One Dollar"

         Case Else

            Dollars = Dollars & " Dollars"

    End Select

    Select Case Cents

        Case ""

            Cents = " and No Cents"

        Case "One"

            Cents = " and One Cent"

              Case Else

            Cents = " and " & Cents & " Cents"

    End Select

    SpellNumber = Dollars & Cents

End Function

      

' Converts a number from 100-999 into text 

Function GetHundreds(ByVal MyNumber)

    Dim Result As String

    If Val(MyNumber) = 0 Then Exit Function

    MyNumber = Right("000" & MyNumber, 3)

    ' Convert the hundreds place.

    If Mid(MyNumber, 1, 1) <> "0" Then

        Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "

    End If

    ' Convert the tens and ones place.

    If Mid(MyNumber, 2, 1) <> "0" Then

        Result = Result & GetTens(Mid(MyNumber, 2))

    Else

        Result = Result & GetDigit(Mid(MyNumber, 3))

    End If

    GetHundreds = Result

End Function

      

' Converts a number from 10 to 99 into text. 

Function GetTens(TensText)

    Dim Result As String

    Result = ""           ' Null out the temporary function value.

    If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...

        Select Case Val(TensText)

            Case 10: Result = "Ten"

            Case 11: Result = "Eleven"

            Case 12: Result = "Twelve"

            Case 13: Result = "Thirteen"

            Case 14: Result = "Fourteen"

            Case 15: Result = "Fifteen"

            Case 16: Result = "Sixteen"

            Case 17: Result = "Seventeen"

            Case 18: Result = "Eighteen"

            Case 19: Result = "Nineteen"

            Case Else

        End Select

    Else                                 ' If value between 20-99...

        Select Case Val(Left(TensText, 1))

            Case 2: Result = "Twenty "

            Case 3: Result = "Thirty "

            Case 4: Result = "Forty "

            Case 5: Result = "Fifty "

            Case 6: Result = "Sixty "

            Case 7: Result = "Seventy "

            Case 8: Result = "Eighty "

            Case 9: Result = "Ninety "

            Case Else

        End Select

        Result = Result & GetDigit _

            (Right(TensText, 1))  ' Retrieve ones place.

    End If

    GetTens = Result

End Function

     

' Converts a number from 1 to 9 into text. 

Function GetDigit(Digit)

    Select Case Val(Digit)

        Case 1: GetDigit = "One"

        Case 2: GetDigit = "Two"

        Case 3: GetDigit = "Three"

        Case 4: GetDigit = "Four"

        Case 5: GetDigit = "Five"

        Case 6: GetDigit = "Six"

        Case 7: GetDigit = "Seven"

        Case 8: GetDigit = "Eight"

        Case 9: GetDigit = "Nine"

        Case Else: GetDigit = ""

    End Select

End Function

Storing user input value

You might have come across with situation when you wanted to give user an option to input something. An "InputBox" is used to capture this. You can store the user entered value anywhere in the speadsheet.

The code is quite simple as given below:

Sub UserInput()
Sheets("Sheet1").Select
MyInput = InputBox("Enter a number")
Range("A1").Value = MyInput
End Sub

You can add more stuffs in this but I have kept it simple and just one thing at a time. So you can directly copy this code and add it in your module along with other codes.

VBA How to open a file from Input from user via "browse"

The following codes will open a window and then you can go to the desired folder to select the file:

Sub GetFile()

Dim fNameAndPath As Variant, wb As Workbook

fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLS", Title:="Select File To Be Opened")

If fNameAndPath = False Then Exit Sub

Set wb = Workbooks.Open(fNameAndPath)

'

'do stuff

'

wb.Close savechanges:=True 'or false

End Sub

Formula to determine Quarter from Date

Excel formula to get Quarter from date:

="Q"&INT((MONTH(BG2)/4)+1)&"-"&RIGHT(YEAR(BG2),2)