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