Finding Cells Filled with a Particular Color

1. Press Ctrl+F to display the Find tab of the Find and Replace dialog box. (See Figure 1.)

Figure 1. The Find tab of the Find and Replace dialog box.
2. Make sure there is nothing in the Find What box.
3. Click Format. (You may need to click Options to see the Format button.) Excel displays the Find Format dialog box.
4. Make sure the Patterns tab is displayed. (See Figure 2.)

Figure 2. The Patterns tab of the Find Format dialog box.
5. From the colors available, choose the color you want to find.
6. Click OK to close the Find Format dialog box.
7. Click Find All. The Find and Replace dialog box expands to show the addresses of all the cells formatted with the color you specified in step 5. (See Figure 3.)

Figure 3. The expanded Find and Replace dialog box.
8. Click one of the cell addresses in the bottom of the dialog box. Excel selects the cell within the actual worksheet.
9. Press Ctrl+A. All of the addresses within the dialog box are selected.
10. Click Close. All the cells of the desired color are selected.

If you are using Excel 97, Excel 2000, or Excel 2002 the only way to select cells of a particular color is to use a macro. Consider the macro shown here:

Sub SelectColoredCells()
    Dim rCell As Range
    Dim lColor As Long
    Dim rColored As Range

    'Select the color by name (8 possible)
    'vbBlack, vbBlue, vbGreen, vbCyan,
    'vbRed, vbMagenta, vbYellow, vbWhite
    lColor = vbBlue

    'If you prefer, you can use the RGB function
    'to specify a color
    'lColor = RGB(0, 0, 255)

    Set rColored = Nothing
    For Each rCell In Selection
        If rCell.Interior.Color = lColor Then
            If rColored Is Nothing Then
                Set rColored = rCell
            Else
                Set rColored = Union(rColored, rCell)
            End If
        End If
    Next
    If rColored Is Nothing Then
        MsgBox "No cells match the color"
    Else
        rColored.Select
        MsgBox "Selected cells match the color:" & _
            vbCrLf & rColored.Address
    End If
    Set rCell = Nothing
    Set rColored = Nothing

End Sub  

To use the macro, select a range of cells before running it. The macro then steps through each selected cell and compares its color with whatever color you specify in lColor. If a match is found, then the cell is added to a selection set. When completed, the macro selects only those matching cells, and then exits.

To Customize the Ribbon in Excel 2013

To Customize the Ribbon in Excel 2013

You can customize the Ribbon by creating your own tabs with whichever commands you want. Commands are always housed within a group, and you can create as many groups as you want in order to keep your tab organized. If you want, you can even add commands to any of the default tabs, as long as you create a custom group in the tab.

1. Right-click the Ribbon and then select Customize the Ribbon... from the drop-down menu.
   
   
2. The Excel Options dialog box will appear. Locate and select New Tab.
   
   
3. Make sure the New Group is selected, select a command, then click Add. You can also drag commands directly into a group.
4. When you are done adding commands, click OK. The commands will be added to the Ribbon.
   
   

If you don't see the command you want, click the Choose commands from: drop-down box and select All Commands.

Find alphabets in a cell

Sub Get_Alpha()

For I = 1 To Range("A1").End(xlDown).Row

    Alp = ""

    For J = 1 To Len(Range("A" & I).Value)

        StrV = Range("A" & I).Value

        If Asc(Mid(StrV, J, 1)) >= 65 And Asc(Mid(StrV, J, 1)) <= 90 Then

            Alp = Alp & Mid(StrV, J, 1)

        ElseIf Asc(Mid(StrV, J, 1)) >= 97 And Asc(Mid(StrV, J, 1)) <= 122 Then

            Alp = Alp & Mid(StrV, J, 1)

        End If

    Next J

    Range("B" & I).Value = Alp

Next I

End Sub

Macro to hide/unhide menu bars in Excel

The 2 macros below are what can be used to show your toolbar, remove all native toolbars and most importantly restore them back when done;

Sub RemoveToolbars()

    On Error Resume Next

        With Application

           .DisplayFullScreen = True

           .CommandBars("Full Screen").Visible = False

           .CommandBars("MyToolbar").Enabled = True

           .CommandBars("MyToolbar").Visible = True

           .CommandBars("Worksheet Menu Bar").Enabled = False

        End With

    On Error GoTo 0

End Sub

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

Sub RestoreToolbars()

    On Error Resume Next

        With Application

           .DisplayFullScreen = False

           .CommandBars("MyToolbar").Enabled = False

           .CommandBars("Worksheet Menu Bar").Enabled = True

        End With

    On Error GoTo 0

End Sub

Get to the last column

LastCol = Cells(3, Columns.Count).End(xlToLeft).Column

Coding the Toolbar Show and Restore

The 2 macros below are what can be used to show your toolbar, remove all native toolbars and most importantly restore them back when done;

Sub RemoveToolbars()

    On Error Resume Next

        With Application

           .DisplayFullScreen = True

           .CommandBars("Full Screen").Visible = False

           .CommandBars("MyToolbar").Enabled = True

           .CommandBars("MyToolbar").Visible = True

           .CommandBars("Worksheet Menu Bar").Enabled = False

        End With

    On Error GoTo 0

End Sub

Excel VBA Sendkeys

Application.SendKeys ("~")

This code will ignore the message box.

Formula to count unique values in my list of data:

Formula to count unique values in my list of data:

=SUM(IF(FREQUENCY(MATCH(A2:A9,A2:A9,0),MATCH(A2:A9,A2:A9,0))>0,1))

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)