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
Search
Thursday, May 26, 2005
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)))
=IF(LEN(T4)=0,"",IF(ISERR(FIND(" ",T4)),T4,LEFT(T4,FIND(" ",T4)-2)))
Labels:
Excel
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
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
Labels:
Excel
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
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
Labels:
Excel
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).
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).
Labels:
Excel
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
Else
strLastVal = Cells(RowNdx, strColumn).Value
End If
Next RowNdx
End Sub
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
Labels:
Excel
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")
=IF(ISNUMBER(MATCH(C1,A:A,0)),"Yes","No")
Labels:
Excel
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$) & " on server " & NewDbServr$ &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$) & " locally." , 4112, "ERROR"
Exit Sub
End If
End Sub
' 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$) & " on server " & NewDbServr$ &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$) & " locally." , 4112, "ERROR"
Exit Sub
End If
End Sub
Labels:
LotusScript
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
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
Subscribe to:
Posts (Atom)