Thursday, May 26, 2005

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
' align the chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
End With


' 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).

Sunday, May 22, 2005

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
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


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 - 1).Delete
End If
End If
Next RowNdx
End Sub