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