Trim and Trap for Empty Cells in Excel

This formula is used to check if a cell has a blank value and if it does, it returns "N/A".  However, some data isn't clean and there may be blank spaces in the referring cell (i.e. not clean).  Here we utilize the Trim and If statements together to clean up any accidental spaces so not to get a blank return instead of N/A

Place this formula in a cell that is referencing the same or a difference sheet with any column of data that you want to return a value and if there is truly nothing (thanks to the Trim function) in that cell, return a "N/A".

=IF(TRIM('All deals'!F2)="","N/A",'All deals'!F2)

Excel Formula to extract text between Parenthesis (Extract This Text)



=MID(A2,FIND("(",A2)+1,FIND(")",A2)-FIND("(",A2)-1)

Excel - Trim Trailing Text

This formula will trim all of the text in a cell after the specified criteria:

Example:

• Sheet content to evaluate are in Column A
• Cell A2 contains the following text:  Thomas (Tom)
• The desired output:  Thomas
• Cell B2 Formula to evaluate Cell A2:  =LEFT(A2,FIND(" (",A2)-1)

=LEFT(A2,FIND(" (",A2)-1)

Trim the last character in an Excel cell

Excel Formula to trim the last character from a cell

• Text values are in Column A2
• Place the formula below in Cell B2 to evaluate Cell A2

=LEFT(A2, LEN(A2)-1)

Merge Multiple Excel Workbook Sheets Into 1 Excel File

This VBA code will:

1. Create a new .xlsx workbook
2. Import the first worksheet for all Excel files within a specified directory
3. The final result will have the first worksheet placed in it's own tab

 

Sub Merge2MultiSheets()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String

    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    MyPath = "C:\users\username\Desktop\Directory of Files" 'Change this path accordingly (Files you want imported)
    Set wbDst = Workbooks.Add(xlWBATWorksheet)
    strFilename = Dir(MyPath & "\*.xlsx", vbNormal) 'Change this extension accordingly (.xlsx, .xls, .txt, etc.)
    If Len(strFilename) = 0 Then Exit Sub

    Do Until strFilename = ""
             Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
             Set wsSrc = wbSrc.Worksheets(1)
             wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
             wbSrc.Close False
             strFilename = Dir()
     Loop

wbDst.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Count the # of unique items in a column, excluding blanks

Excel Formula to count the # of unique items in a column, excluding blanks

 

=SUMPRODUCT((B21:B1421<>"")*(1/COUNTIF(B21:B1421,B21:B1421 &"")))

Excel "IF~OR~AND" Formula

Excel Formula to check if B1 or C1 or D1 contain a value of "1" AND if the E1 = "1".  If TRUE, then A1 = "1", otherwise, A1 = "0".

Place the following formula in cell A1:

=IF(AND(OR($B$1=1,$C$1=1,$D$1=1),$E$1=1),1,0)

Excel - Search Cell for Matching Value

Excel Formula to search a cell's contents for the value within quotes and determine if it contains a match.  If True, it returns the cell's contents.  If False, it leaves it blank.

=IF(ISNUMBER(SEARCH("Ticket",A2)),A2,"")     

Parse Cell String Contents (VBA)

Thanks to my buddy Smitty for help on this one...

The VBA Module below will search a column of data (in this case:  Col G, Row 2 down) and take a cell's contents and convert it to a string.  It will then search the String for 2 key words (specified in the code below) and return the text value that sits 'in between'.  If the code encounters a duplicate within the cell (aka: string), it will ignore it and only return the unique value(s) between the 2 key words.  With this specific routine, it finds the instance(s) of "Component: " and "; Outcome" and counts backwards 11 spaces to return the value in between.  When re-using this code, please remember to modify the "Range" values, Component / Outcome key words (in quotes), and finally the # of characters with which to Start and End the parsed value.



Sub GetValues()

    Dim rngCell As Range
    Dim strName As String
    Dim Component As Integer
    Dim Outcome As Integer
    Dim CompleteResult As String
    Dim CurrentResult As String
    Dim ComponentCnt As Integer
    Dim RowCnt As Integer

    RowCnt = Range("G1").End(xlDown).Row
    Range("H2:H" + Trim(str(RowCnt - 1))).Select
    Selection.ClearContents

    For Each rngCell In Range("G2", Range("G1").End(xlDown))
        CompleteResult = ""
        strName = rngCell.Value

' Change the keyword values below to accomodate your "in between" criteria.
        Component = InStr(1, strName, "Component: ")
        Outcome = InStr(1, strName, "; Outcome")
        While Component > 0
            If CompleteResult <> "" Then
                CompleteResult = CompleteResult + vbLf
            End If
           
            ' Prevent Duplicates
            ' The number values in the line immediately following = spaces left and right to start the string start and finish points.
            CurrentResult = Mid(strName, Component + 11, Outcome - Component - 11)
            If InStr(CompleteResult, CurrentResult) = 0 Then
                CompleteResult = CompleteResult + CurrentResult
            End If
           
            Component = InStr(Outcome + 1, strName, "Component: ")
            Outcome = InStr(Outcome + 1, strName, "; Outcome")
        Wend
       
        rngCell.Offset(0, 1).Value = CompleteResult
    Next rngCell

    MsgBox ("DONE")
End Sub

Excel Sort Function

The Excel Formula below is an array formula that will sort a column and bring the contents to the top of the list.  It’s particularly useful if you have blanks in your data that’s intermittently placed throughout a column.  If you want the data to display at the bottom (instead of the top of the list), just swap out the word “LARGE” below with “SMALL”.  Enter the formula and drag down adjacent to the list that you want evaluated.  Remember to press SHIFT + CTRL + ENTER on the first cell to make it an array formula…then drag down from there. 

{=INDEX($L$131:$L$190,MATCH(LARGE(COUNTIF($L$131:$L$190,"<"&$L$131:$L$190),ROW(1:1)),COUNTIF($L$131:$L$190,"<"&$L$131:$L$190),0))}

InfoPath Shrinking List Filter

To allow for “Shrinking” Values within an InfoPath Combo Box, use the following “Expression”.  The selected value will only be allowed to be used once in the repeating table.

not(. = xdXDocument:get-DOM()//my:FieldName)

Excel Cell Search & Calc

Thanks to my buddy Ron for this challenge...

The Excel Formula below is handy when you want to search for a specific value contained within an adjacent cell and then do a calculation of time that rounds up to the nearest quarter hour.  This formula includes error trapping if the searchable cell contains a null value.


=IFERROR(CEILING(IF(OR(ISNUMBER(SEARCH("*R*",H2)),ISNUMBER(SEARCH("*A*",H2))),AD2,IF(ISNUMBER(SEARCH("*C*",H2)),AD2*DataRef!$B$1,IF(ISNUMBER(SEARCH("*I*",H2)),AD2*DataRef!$B$2,""))),0.25),"")

Excel "In Between"

This Excel example will show you how to determine if a cell value is "In Between" a pre-established range. Please see the details below for setup steps and a visual example...

Example Assumptions:

• The spreadsheet has been named: Range Example
• This cell value that you wish to calculate is: A8
• The 'in between' values to check against are placed in cells: B4:L4

Setup Steps:

1. Create your "in between" values somewhere on the spreadsheet (Cells B4:L4 are used in this example)
2. Create a "Named Range". In this example, the Named Range has been called: "SPREAD".
3. In the "Refers to:" field for "SPREAD", enter the following reference: ='Range Example'!$B$4:$L$4
4. Click 'OK' to save the Named Range.
5. Enter the formula below into a cell that's (preferably) adjacent to the cell that you wish to find the range for:

=INDEX(SPREAD,-SUMPRODUCT(-(-(LEFT(SPREAD,FIND(" ",SPREAD)-1))>=(-A8))))

The formula above uses the "SPREAD" Named Range, which you defined earlier, to determine if the referenced cell is 'in between' the pre-established range.

For a visual representation of how to set this up, please see the screen shot below...

Dynamic Range Assignment

Dynamic Referencing for Excel Pivot Table(s) and / or Graph(s)

BC, this one's for you... :-)

Situation: You have an Excel solution that auto generates Graphs and / or Charts based on a specific set of data that changes over time. Instead of manually re-selecting a new Data Source for your Pivot Table(s) and / or Graph(s) each time your Raw Data changes (i.e. appending Q2 data to Q1, etc.), check out the information below for a dynamic solution...

• Excel Sheet Name = "DataTab"
• Column Headers Accross the top beginning with A1
• Subsequent Data lies beneath each Header
• Assuming your data is standardized and consistent over time
• Create a Named Range called "DataRange" and paste in the following formula...

=OFFSET('DataTab'!$A$1,0,0, COUNTA('DataTab'!$A:$A), COUNTA('DataTab'!$1:$1))

• Assign the above Named Range ("DataRange") to your Pivot Table and/or Graph as it's Data Source

• Refresh your Table(s) / Graph(s) - Can be done manually, via Table Settings, or with VBA

When you paste in future data that may be different from your original data, your Graph(s) and / or Chart(s) will now be based on a dynamically growing or shrinking dataset that matches your "evolved" Data Source.

Compare & Consolidate

Excel Value Comparison & Result Consolidation

If This ~ Or That ~ Then This ~ Else This
With raw data in cell(s) A2:xx, place the following formula in cell(s) B2:xx

=IF(OR(ISNUMBER(SEARCH("*Item1*",A2)),(ISNUMBER(SEARCH("*Item2*",A2)))),"Assigned Value",A2)
This formula will search the contents of cell A2 and if it finds anything relating to “Item1” OR “Item2”, it will place the word “Assigned Value” in B2. If it doesn’t find the referring value, it will simply place the existing contents of cell A2 in cell B2.

Excel Nested IF's

A well known limitation to Excel is that you cannot "nest" more than 7 functions. For example, the following formula will fail because the limit is exceeded.

=IF(Sheet1!$A$4=1,11,IF(Sheet1!$A$4=2,22,IF(Sheet1!$A$4=3,33,IF(Sheet1!$A$4=4,44,IF(Sheet1!$A$4=5,55,IF(Sheet1!$A$4=4,44,IF(Sheet1!$A$4=5,55,IF(Sheet1!$A$4=6,66,IF($A$4=7,77,FALSE))))))))

As a general "rule of thumb," if you have a formula with more than 7 nested statements, you should consider using a VBA function instead. However, if you do not want to use VBA, you can get around this limitation by creating a defined name that refers to part of the formula. Since defined formulas are evaluated separately, you can have one or more defined formulas which refer to large formulas, and combine these into a "master" formula.

Suppose we wanted an nested IF formula to test: IF A4 = 1 Then 11 Else If A4 = 2 Then 22 Else If A4 = 3 Then 33 Else If A4 = 4 Then 44...Else If A4 = 55 Then 55 Else "Not Found" and so on.

Of course, as a practical matter, we'd be better off using a VLOOKUP to do this, but this will work for illustration. First, we'd create a named formula called OneToSix, referring to the formula:

=IF(Sheet1!$A$4=1,11,IF(Sheet1!$A$4=2,22,IF(Sheet1!$A$4=3,33,IF(Sheet1!$A$4=4,44,IF(Sheet1!$A$4=5,55,IF(Sheet1!$A$4=4,44,IF(Sheet1!$A$4=5,55,IF(Sheet1!$A$4=6,66,FALSE))))))))

Then create another named formula called SevenToThirteen, referring to the formula:
=IF(Sheet1!$A$4=7,77,IF(Sheet1!$A$4=8,88,IF(Sheet1!$A$4=9,99,IF(Sheet1!$A$4=10,100,IF(Sheet1!$A$4=11,110,IF(Sheet1!$A$4=12,120,IF(Sheet1!$A$4=13,130,"NotFound")))))))

Finally, enter the "master" formula in the worksheet cell: =IF(OneToSix,OneToSix,SevenToThirteen)

It's not pretty, but it can be a work around in a pinch...This "beats" the nested function limitation because no single part of the formula exceeds the limit, even though the "sum" of the components do. You can use this technique whenever you exceed the limit on nested functions.

Quarter Calculation

Infopath Field Function to Calculate the "Quarter" based on a previously entered date

1. Create a Field named "Date"
2. Create a Rule on the "Date" field
3. Enter this formula as the Value for the Rule: floor(((number(substring(., 6, 2)) + 11) / 3) mod 4) + 1
4. Set Condition to "None - This rule always applies"
5. Create a field named "Quarter"
6. Set the "Quarter" field's Data Type to: "Whole Number (Integer)"

Excel - Current Quarter Calc

Excel Formula to Calculate the Current Quarter

=IF(LEN(B2) > 0,VLOOKUP(MONTH(B2),{1,"Q1";4,"Q2";7,"Q3";10,"Q4"},2),"") & IF(LEN(B2)>0,IF(OR(MONTH(B2)=1,MONTH(B2)=2)," '" & RIGHT(YEAR(B2),2)," '" & RIGHT(YEAR(B2),2)),"")

Excel - Trim Last 5 Characters

Excel Formula to capture and trim the last 5 characters of an adjacent Field that contains a string value

=RIGHT(C37,LEN(C37)-FIND("*",SUBSTITUTE(C37," ","*",LEN(C37)-LEN(SUBSTITUTE(C37," ","")))))

JScript to Get Base Form Library URL

//GET Base URL of an Originating Form Library (WITHOUT a trailing /)

strUri = XDocument.Solution.URI;
strPath = strUri.substring(0, strUri.indexOf("Forms") - 1);
XDocument.UI.Alert(strPath)

//GET Base URL of an Originating Form Library (WITH a trailing /)
strUri = XDocument.Solution.URI;
strPath = strUri.substring(0, strUri.indexOf("Forms"));
XDocument.UI.Alert(strPath)

JScript Case / Switch Example

function msoxd_my_Approval_Status::OnAfterChange(eventObj)
{
// Write code here to restore the global state.

        if (eventObj.IsUndoRedo)
                {
                        // An undo or redo operation has occurred and the DOM is read-only.
                        return;
                }

var StatusChoice = XDocument.DOM.selectSingleNode("/my:myFields/my:InputData/my:Approval_Status").text

        switch (StatusChoice)
                {
                        case "Approved":
                        XDocument.DOM.selectSingleNode("/my:myFields/my:Admin/my:Approval_Status_FLAG").text = "Approved";
                        break;

                        case "In Process":
                        XDocument.DOM.selectSingleNode("/my:myFields/my:Admin/my:Approval_Status_FLAG").text = "In Process";
                        break;

                        case "Rejected":
                         XDocument.DOM.selectSingleNode("/my:myFields/my:Admin/my:Approval_Status_FLAG").text = "Rejected";
                        break;

                        default:
                        XDocument.DOM.selectSingleNode("/my:myFields/my:Admin/my:Approval_Status_FLAG").text = "No Change in Status";
                }

// A field change has occurred and the DOM is writable. Write code here to respond to the changes.
}

Excel Progress Indicator

Displaying a Progress Indicator in Excel...

I can't take credit for this code...I found it on the internet at this address: http://j-walk.com/ss/excel/tips/tip34.htm

KUDO's to the original developer, who ever it is...
-----------------------------------
Click HERE to download an example
A common question among Excel developers is, How can I use a custom dialog
box to display the progress of a lengthy macro? This document describes
how to create an attractive progress indicator with minimal effort.
Creating the UserFormFollow the steps below to create the progress indicator UserForm.

1. Insert a new UserForm and change its Caption to Progress.
2. Add a Frame control and name it FrameProgress.
3. Add a Label control inside of the Frame and name it LabelProgress.
4. Remove the Label's caption, and make its background color red.
5. Add another label (option) to describe what's going on.
6. Adjust the form and controls so they look like this:

Creating the Event-handler subroutines
The trick here involves running a subroutine automatically when the dialog box is displayed. Since the Initialize event occurs before the dialog box is actually show, you must use the Activate event. Insert the following subroutine in the Code window for the UserForm. This subroutine simply calls the Main subroutine (stored in a VBA module) when the UserForm is displayed.
CODE:
-----------------------------------
Private Sub UserForm_activate()
Call Main
End Sub
-----------------------------------
The Main subroutine is listed below. This demo routine simply inserts random numbers into the active worksheet. As it does so, it changes the width of the Label control and displays the percent completed in the Frame's caption. You will, of course, substitute your own subroutine. And you'll need to figure out how to determine the progress complete.
-----------------------------------
CODE Continued:
Sub Main()

' Inserts random numbers on the active worksheet
Dim Counter As Integer
Dim RowMax As Integer, ColMax As Integer
Dim r As Integer, c As Integer
Dim PctDone As Single
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
Cells.Clear
Application.ScreenUpdating = False
Counter = 1
RowMax = 100
ColMax = 25
For r = 1 To RowMax
For c = 1 To ColMax
Cells(r, c) = Int(Rnd * 1000)
Counter = Counter + 1
Next c
PctDone = Counter / (RowMax * ColMax)
With UserForm1
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With
' The DoEvents statement is responsible for the form updating
DoEvents
Next r
Unload UserForm1
End Sub
-----------------------------------
Creating the start-up subroutine
All that's missing is a subroutine to display the dialog box. Enter the following subroutine in a VBA module.
-----------------------------------
CODE Continued:
Sub ShowDialog()
UserForm1.LabelProgress.Width = 0
UserForm1.Show
End Sub
-----------------------------------
How it works
When you execute the ShowDialog subroutine, the Label object's width is set to 0. Then the Show method of the UserForm1 object displays the dialog box. When the dialog box is displayed, its Activate event is triggered, which executes the Main subroutine. The Main subroutine
periodically updates the width of the Label. Notice the DoEvents statement. Without this statement, changes to the Label are not visible. Before the subroutine ends, the last statement unloads the UserForm object.
Caveat
This is definitely a slick technique, but you should be aware that it may slow down your macro a bit due to the extra overhead of updating the progress indicator. In many cases, however, it is not even noticeable.

Excel Formula comparison (If~Then~AND~Else)

=IF(AND(E14="",D14<>""),"No Personal Miles","")

Excel Formula to count word instances in a column based on 2 different criteria

=SUMPRODUCT(('Raw Data Tab'!$K$2:$K$15=$A3)*('Raw Data Tab'!$L$2:$L$15=I$1))

#N/A Trap and VLookup Combo

Excel Formula to trap for #N/A and perform another VLookup using a modified KEY Value


=IF(ISNA(VLOOKUP(D2,'Goal and Activity
Data'!$D$2:$Y$795,3,FALSE)),VLOOKUP(LEFT(D2,LEN(D2)-2),'Goal and Activity
Data'!$D$2:$Y$795,3,FALSE),(VLOOKUP(D2,'Goal and Activity
Data'!$D$2:$Y$795,3,FALSE)))

In Excel, code to grab the text to the right of any specific character

=TRIM(RIGHT(A1,LEN(A1)-SEARCH("(",A1)))

Error Trapping code for when a user tries to edit a Lotus Notes Document using CTRL + E when a category is selected instead of a document

This example uses a button and code behind the button to prompt the user if they have selected a category instead of a document within a view to edit. It tells how to error trap and refocus the user on the correct behavior. Most of the time when a view is designed, we put an "Edit Document" button on the view so users can click on the button instead of pressing CTRL+E or opening the document in read mode and then switching to edit mode. If the view is categorized, though, there are rows that are not documents. If you
click on the "Edit Document" button while on a category row, you get a "Cannot execute the specified command" error. There is a way to prevent that error from happening. If you check the UNID of the document, Notes will return a string of zeros when you are on a category row. So your "Edit
Document" button, instead of having just the formula you would expect...

@Command([EditDocument])

...you add some additional logic to the button...

UNID := @Text(@DocumentUniqueID);

@If(UNID = @Repeat("0"; @Length(UNID)); @Prompt([OK]; "Category"; "Please
select a document"); @Command([EditDocument]))

The button now checks what the UNID of the current document is. If that is a string of zeros, then give a message to the user that they are on a category and not a document. If it isn't a string of zeros, edit the
document. That makes the error message a little friendlier while still allowing all the functionality that used to be there.

Did you say something about Notes 6?

In Notes 6, you can take this one step further. You can actually have the button not even appear to the user if they're on a category. That's a nice feature to take advantage of. Your users won't even have a button to click on if the "time isn't right".

Note: make sure your users are all right with this before simply implementing it. Having buttons appear/disappear may be bothersome to users, which could end up causing more headaches than it solves. This feature will also have a performance hit (you'll see why in a minute) which may be too much for your users to take. To implement the showing and hiding of buttons in Notes 6, you need to enable a new view property called "Evaluate actions for every document change". You can see that in figure 1. This tells the Notes client that every time a new row in the view is clicked (or the up/down arrows are pressed, which changes focus), the action buttons should be refreshed. So, you can apply a hide-when formula to an action button and it will be refreshed. Using that same logic as above, if the UNID of the current "document" is a string of zeros, then we are on a category line and should hide the button. The action button hide-when formula becomes:

UNID := @Text(@DocumentUniqueID);
UNID = @Repeat("0"; @Length(UNID))

Now, as you move up and down the view or click around to select different rows, the action buttons will be re-evaluated (if that view setting is enabled) and the button will be hidden if you are currently on a category
row. If you didn't figure out the performance hit already, it comes from the fact that all the hide-when formulas on all the action buttons will be re-evaluated every time you move in the view. If you only have a couple of action buttons, the performance hit may not be noticeable. But if you have a bunch of cascaded action buttons with hide formulas, there could be a noticeable delay moving from one document to another in the view.

VB MsgBox Function Example

MsgBox Function Example

This example uses the MsgBox function to display a critical-error message
in a dialog box with Yes and No buttons. The No button is specified as the
default response. The value returned by the MsgBox function depends on the
button chosen by the user. This example assumes that DEMO.HLP is a Help
file that contains a topic with a Help context number equal to 1000.

Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Do you want to continue ?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "MsgBox Demonstration" ' Define title.
Help = "DEMO.HLP" ' Define Help file.
Ctxt = 1000 ' Define topic
' context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' User chose Yes.
MyString = "Yes" ' Perform some action.
Else ' User chose No.
MyString = "No" ' Perform some action.
End If

Trapping for instance of #NA in Excel

Trapping for instance of #NA in an excel vlookup and replacing with a 0 (zero) so you can use the value in a sum formula

=IF(ISNA(VLOOKUP(A3,'Sheet1'!$A$4:$K$907,5,FALSE)),0,VLOOKUP(A3,'Sheet1'!$A$4:$K$907,5,FALSE))

Hiding Sheet Tabs in Excel upon Sheet Activation

Private Sub Worksheet_Activate()
With ActiveWindow.Display WorkbookTabs = False
End With
End Sub

VBA Code to trim everything EXCEPT the last text string in a cell

'To use this UDF push Alt+F11 and go Insert>Module and paste in the code.
Push Alt+Q and save. The Function will appear under "User Defined" in the
Paste Function dialog box (Shift+F3). Use the Function as shown in the
graphic example below.

Function ReturnLastWord(The_Text As String)
Dim stGotIt As String

i = 1
Do Until stGotIt Like (" *")
stGotIt = Right(The_Text, i)
i = i + 1
Loop

ReturnLastWord = Trim(stGotIt)
End Function

Excel - Full Name Parsing

The code below details out several worksheet functions you can use to split full names into the first and last name components.

To return the last name of the full name in A2, use the following formula.
=LEFT(A2,IF(ISERROR(FIND(",",A2,1)),LEN(A2),FIND(",",A2,1)-1))
To return the first name of the full name in A2, use the following formula.
=TRIM(IF(ISERROR(FIND(",",A2,1)),A2,MID(A2,FIND(",",A2,1)+1,IF(ISERROR(FIND(" ",A2,FIND(",",A2,1)+2)),LEN(A2),FIND(" ",A2,FIND(",",A2,1)+2))-FIND(",",A2,1))))
To return the middle name of the full name in A2, use the following formula.
=TRIM(RIGHT(A2,LEN(A2)-IF(ISERROR(FIND(" ",A2,FIND(" ",A2,FIND(",",A2,1)+2))),LEN(A2),FIND(" ",A2,FIND(" ",A2,FIND(",",A2,1)+2))-1)))

Excel - 9 digit zip codes trimmed to first 5 digits

This code will trap for zip codes that have a "-" in it as a separator then trim 5 characters off the end to reveal only 5 digits.

=IF(LEN(P2)=5,P2,LEFT(P2,LEN(P2)-5))

Example: 46033-9695

after code execution "46033" will be displayed.

Excel Macro to Insert Rows

This code will insert the specified number of rows in an Excel Spreadsheet based on user input. Row insert will take place from the current cell you have selected

Sub Add_Rows()
Dim Rng
Rng = InputBox("Enter number of rows required.")
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(Rng - 1, 0)).Select
Selection.EntireRow.Insert
End Sub

Code to send E-mail from MS Excel (Outlook or Outlook Express)

ActiveWorkbook.SendMail Recipients:="E-Mail Address"

Code to copy selected Excel Cells to Powerpoint Presentation via a Macro / Button

Sub RangeToPresentation()
'Set a VBE reference to Microsoft PowerPoint Object Library
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
' Make sure a range is selected
If Not TypeName(Selection) = "Range" Then
MsgBox "Please select a worksheet range and try again.", vbExclamation, "No Range Selected"
Else
' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
'Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
' Reference active slide
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
' Copy the range as a picture
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
' Paste the range
PPSlide.Shapes.Paste.Select
' Align the pasted range
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End If
End Sub

Code to hide and unhide worksheets in Excel

To Hide a worksheet: Goto VB Editor Window and type:

thisworkbook.Worksheets("name of workbook").visible=xlsheetveryhidden

To Unhide an Excel Worksheet: Goto VB Editor Window and type:

thisworkbook.Worksheets("name of workbook").visible=xlsheetvisible

Locking Scroll Bars in Excel

Enter the following code in the “Workbook� area of the VB Editor to lock down the scroll bars

Private Sub Workbook_Open()
ThisWorkbook.Worksheets(name of workbook).ScrollArea = "$A$1:$b$10"End Sub

Automatic Highlighting of Active Row

This code must be placed in the Private Module of the Worksheet. To get there right click on the sheet name tab and select "View Code". Here is a handy little bit of code that will highlight the current row as you select it. But only if the row is NOT empty.

Private Sub Worksheet_Selection
Change(ByVal Target As Range)
Dim strRow As String
Cells.FormatConditions.Delete
With Target.EntireRow
strRow = .Address
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=COUNTA(" & strRow & ")>0"
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 15
End With
End Sub

Prevent a user saving a Workbook as another name. That is, stop the Save as dialog box from showing.

Private Sub Workbook_BeforeSave _
(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI = True Then Cancel = True
End Sub

Excel code to run your code when the Workbook opens, Activates, Deactivates, Closes and Saves

The code below shows you how you can use Excels Workbook Events to run your code when the Workbook opens, Activates, Deactivates, Closes and Saves. The quickest way to get to Excels Workbook Events is to right click on the sheet picture (top left next to "File") and select "View Code". Then choose an event from the "Procedure" drop down list box.

For Excel 2000 you will need to select "Workbook" from the "Object" drop down list box first. All examples must be placed within the Private Module of the Workbook Object "ThisWorkbook" as described above. Unless stated otherwise! Hide all of Excels standard Menus and Toolbars and show only your Custom Toolbar.This code will decide if the user has closed your Workbook or simply Activated another. This code (unless changed) assumes you have a Custom Toolbar called "MyToolBar" which is attached to the Workbook.

Whenever the user closes or deactivates the Workbook, all Toolbars and Menubars will be restored as before. To attach your a Custom Toolbar go to View>Toolbars>Customize-Attach then Copy your Custom Toolbar to the Workbook.

'Module level declaration
Dim IsClosed As Boolean, IsOpen As Boolean
Private Sub Workbook_Activate()
'Show the Custom toolbar
IsClosed = False
If IsOpen = False Then
Application.ScreenUpdating = False
Run "HideMenus"
Application.ScreenUpdating = True
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
IsClosed = True 'Closing so set to True
If Cancel = True Then IsClosed = False
'Changed their mindEnd Sub
Private Sub Workbook_Deactivate()Application.ScreenUpdating = False
IsOpen = False
On Error Resume Next 'In case it's already gone.
If IsClosed = True Then 'Workbook is closing.
With Application.CommandBars("MyToolBar")
.Protection = msoBarNoProtection
.Delete
End With
Run "ShowMenus"
Else 'They have only activated another Workbook
Run "ShowMenus"
End IfApplication.ScreenUpdating = True
End Sub

Excel code to remove any screen refresh / flicker during execution

Remove screen flickering in Excel when a macro runs to refresh data

Application.ScreenUpdating = False

Return screen back to normal after macro runs and refreshes data

Application.ScreenUpdating = True

Excel code to grab the first word in a referring cell

In this case…Cell, T4, has the value in it you want.

=IF(LEN(T4)=0,"",IF(ISERR(FIND(" ",T4)),T4,LEFT(T4,FIND(" ",T4)-2)))

Excel - Trim text from the end of a text string

To remove the last "X" number of text characters in an excel cell...create a separate column and put the following code into the adjacent cell you want changed:

D4 is the cell that contains a text string: I love the month of May

the following formula =LEFT(D4,LEN(D4)-2) will go in cell E4

The formula will remove the last 2 characters in the above italicized text string to display this:

I love the month of M

Code to copy a Graph or Chart from MS Excel to a Powerpoint Presentation via a Macro / Button

I can't remember where I found this on the internet, but huge kudo's to the original coder. This is extremely useful if you need to port Excel graphs to Powerpoint without all the excess supporting baggage that makes an excel graph balloon a .PPT presentation.

Simply create a new macro and use the code below. If you want, you can assign the macro to a VB Button on the Excel Tab. Or, if you don't want to create a VB Button, simply create a macro and goto the Excel tab where the charts and graphs are located and run it. Make sure you have an actively open .PPT file so the macro can send the charts to Powerpoint.


Sub ChartsToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer

' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide

For iCht = 1 To ActiveSheet.ChartObjects.Count
' copy chart as a picture
ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide
' paste and select the chart picture
.Shapes.Paste.Select
' align the chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
End With

Next

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub

Charting rolling and growing data in Excel

Your data is as shown to the left. Each month you will add new data and you want the chart to automatically include the new data.

1) Using Insert/Name/Define define two names
Date =OFFSET(Sheet1!$A$2,0,0,COUNTA(Sheet1!$A:$A)-1)
Sales =OFFSET(Sheet1!$B$2,0,0,COUNTA(Sheet1!$B:$B)-1)
2) Draw a chart using A1:B5

3) Click on the data series in the chart. The formula bar will show:
=SERIES(Sheet1!$B$1, Sheet1!$A$2:$A$5, Sheet1!$B2:$B5, 1)
Change this to: =SERIES( , Sheet1!Date, Sheet1!Sales, 1). When you are finished, Excel converts this to: =SERIES( , Book1!Date, Book1!Sales, 1 (or whatever your file is named).

Replicating or FILL DOWN in Excel

Perhaps the all time best code written for time saving purposes. Special thanks goes to Matt Smith (TLO) for being there in my time of coding need. This code is specifically useful if you get a large spreadsheet handed to you by your boss that has an account number and to the column adjacent to it, 12 months listed with corresponding sales numbers. He asks you to create an analysis on each month's sales figures due by the end of the day (totally unrealistic if you have 62,000 rows of data. However, with this code, you might be able to meet the challenge, just as I did. Good luck!

Public Sub DuplicateValues()
Dim RowNdx As Long
Dim strLastVal As String
Dim intNumRows As Long
Dim strColumn As String
intNumRows = InputBox("How Many Rows Should I Check?")
strColumn = InputBox("Which Column Should Be Checked?", , "A")
strLastVal = Cells(2, strColumn).Value
For RowNdx = 3 To intNumRows
If Cells(RowNdx, strColumn).Value = "" Then
Cells(RowNdx, strColumn).Value = strLastVal
Else
strLastVal = Cells(RowNdx, strColumn).Value
End If
Next RowNdx
End Sub

Yes / No check for 1 cell to everything in the same row in Excel

Excel statement that displays “yes� or “no� if content in cell C1 equals or doesn’t equal anything in column A

=IF(ISNUMBER(MATCH(C1,A:A,0)),"Yes","No")

Lotus Notes code to deploy a database via E-Mail Button

Sub Click(Source As Button)
' declare applicatioin specific variables here
NewDbServr$ = "Servername" ' <<=== Replace this with the name of server which stores the new application
NewDbName$ = "path\filename.nsf" ' <<=== Replace this with the name of the new application to be cascaded

Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim ServrDb As NotesDatabase ' object for the database being deployed
Dim LocalDb As NotesDatabase ' object for the database being replicated locally

' Local replica creation section - repeat as needed for new databases
Print "Opening database " & NewDbName$
Set ServrDb = New NotesDatabase(NewDbServr$, NewDbName$)
If Not ServrDb .IsOpen Then
Messagebox "PLEASE REPORT THIS ERROR MESSAGE TO YOUR SYSTEMS ADMINISTRATOR: Unable to open the database " & Ucase(NewDbName$) &amp; " on server " & NewDbServr$ &amp;amp; "." , 4112, "ERROR"
Exit Sub
End If
Print "Creating local replica of " & NewDbName$
Set LocalDb = ServrDb.CreateReplica("", NewDbName$)
If Not LocalDb.IsOpen Then
Messagebox "PLEASE REPORT THIS ERROR MESSAGE TO YOUR SYSTEMS ADMINISTRATOR: Unable to replicate the database " & Ucase(NewDbName$) &amp; " locally." , 4112, "ERROR"
Exit Sub
End If
End Sub

Code to remove duplicate rows of data within Excel

Here's some AMAZING code to remove duplicate rows of data in Excel...

This code flat out rocks! It has saved me from having to spend hundreds of hours in manual data delete 'hell'.


De-Dups redundant rows in MS Excel based on column A1 to the end of the data

Paste the following code in a VB Macro in an Excel workbook

Sub DeDup()
Dim RowNdx As Long
For RowNdx = Range("A1").End(xlDown).Row To 2 Step -1
If Cells(RowNdx, "A").Value = Cells(RowNdx - 1, "A").Value Then
If Cells(RowNdx, "B").Value <= Cells(RowNdx - 1, "B").Value Then
Rows(RowNdx).Delete
Else
Rows(RowNdx - 1).Delete
End If
End If
Next RowNdx
End Sub