Excel -- Filters -- Advanced Filters -- Introduction

http://www.contextures.com/xladvfilter01.html

1. Advanced Filters--Introduction      a) Apply an Advanced Filter     b) Filter Unique Records     c) Extract Data to Another Worksheet     d) Setting up the Criteria Range      e) Using Wildcards in Criteria      f) Criteria Examples 2. Advanced Filters -- Complex Criteria

Apply an Advanced Filter 1. Set up the database The first row (A1:D1) has headings. Subsequent rows contain data. There are no blank rows within the database. There is a blank row at the end of the database, and a blank column at the right.

For a zipped workbook with sample data and criteria, click here.

2. Set up the Criteria Range (optional) In the criteria range, you can set the rules for the data that should remain visible after the filter is applied. You can use one criterion, or several. In this example, cells F1:F2 are the criteria range. The heading in F1 exactly matches a heading (D1) in the database. Cell F2 contains the criterion. The > (greater than) operator is used, with the number 500 (no $ sign is included).. After the filter is applied, orders with a total greater than $500 will remain visible. Other operators include: < less than  <= less than or equal to  >= greater than or equal to  <> not equal to

3. Set up the Extract Range (optional) If you plan to copy the data to another location, you can specify the columns that you want to extract. If you want to extract ALL columns, you can leave the extract range empty. Select the cell at the top left of the range for the extracted data. Type the headings for the columns that you want to extract. These must be anexact match for the column headings, in spelling and punctuation. The column order can be different, and any or all of columns can be included.

4. Apply the Filter Select a cell in the database. From the Data menu, choose Filter, Advanced Filter. (In Excel 2007, click the Data tab on the Ribbon, then click Advanced Filter.) You can choose to filter the list in place, or copy the results to another location. Excel should automatically detect the list range. If not, you can select the cells on the worksheet. Select the criteria range on the worksheet If you are copying to a new location, select a starting cell for the copy Note: If you copy to another location, all cells below the extract range will be cleared when the Advanced Filter is applied. Click OK

Filter Unique Records You can use an Advanced Filter to extract a list of unique items in the database. For example, get a list of customers from an order list, or compile a list of products sold: Note: The list must contain a heading, or the first item may be duplicated in the results. Select a cell in the database. From the Data menu, choose Filter, Advanced Filter.(In Excel 2007, click the Data tab on the Ribbon, then click Advanced Filter.) Choose 'Copy to another location'. For the List range, select the column(s) from which you want to extract the unique values. Leave the Criteria Range blank. Select a starting cell for the Copy to location. Add a check mark to the Unique records only box. Click OK. Watch the Video View the steps described above, in a short video clip.   Excel 2007 video

Extract Data to Another Worksheet If the database is on Sheet1 and you would like to extract data to Sheet2: Go to Sheet 2 Select a cell in an unused part of the sheet (cell C4 in this example). From the Data menu, choose Filter, Advanced Filter.(In Excel 2007, click the Data tab on the Ribbon, then click Advanced Filter.) Choose Copy to another location. Click in the List Range box Select Sheet 1, and select the database. (optional) Click in the Criteria range box. Select the criteria range Click in the Copy to box. Select the cell on Sheet 2 in which you want the results to start, or select the headings that you have typed on Sheet 2. (optional) Check the box for Unique Values Only Click OK

Setting up the Criteria Range AND vs OR If a record meets all criteria on one row in the criteria area, it will pass through the filter. In example 1, at right -- customer must be MegaMart AND product must be Cookies AND total must be greater than 500.	1.
Criteria on different rows are joined with an OR operator. In the second example at right -- customer must be MegaMart OR product must be Cookies OR total must be greater than 500.	2.
By using multiple rows, you can combine the AND and OR operators. In the third example at right --  customer must be MegaMart AND product must be Cookies  OR product must be Cookies AND total must be greater than 500.	3.

Using Wildcards in Criteria Use wildcard characters to filter for a text string in a cell.

The * wildcard The asterisk (*) wildcard character represents any number of characters in that position, including zero characters. In this example, any customer whose name contains "mart" will pass through the filter.

The ? wildcard The question mark (?) wildcard character represents one characters in that position. In this example any 4-letter product that begins with c, and ends with ke, will pass through the filter.

The ~ wildcard The tilde (~) wildcard character lets you search for characters that are used as wildcards. In this example any products that begins with Good and ends with Eats, will pass through the filter. To find only the product named Good*Eats, use a tilde character in front of the asterisk.

Criteria Examples Extract Items in a Range To extract a list of items in a range, you can use two columns for one of the fields (e.g. Date). If you enter two criteria on the same row in the criteria range, you create an AND statement. In this example, any records that are extracted must be greater than the first date AND less than the second date.
Create Two or More Sets of Conditions If you enter criteria on different rows in the criteria range, you create anOR statement. In this example, extracted records must meet both conditions in row 2 OR both conditions in row 3.
Extract Items with Specific Text When you use text as criteria with an advanced filter, Excel finds all items that begin with that text. For example, if you type "Ice" as a criterion, Excel finds "Ice", "Ice Cream" and "Ice Milk" To extract only the records for Ice, use the following format:       ="=Ice"

2. Advanced Filters -- Complex Criteria
For a zipped workbook with sample data and criteria, click here.

Animated Gif Archive

http://www.harrythecat.com/graphics/m.htm#dice

Animated gif - Userform

http://www.xcelfiles.com/AnimatedGif.html

"Need to use an animated gif on a userform?

'If you looked around the Net or here you would realize that you either need

1) A dll control for this OR

2) MS web browser control.

3) or some other ActiveX control.

'Either way if you were to distribute your workbook, you needed to include other files, weather that is the dll or the actual gif files. So when ever you gave out this file to someone else they needed these files.

Using the WebBrowser control.

'Here is a way that gets around this by actually reading the gif file data from a sheet and creating the gif file. This is then referenced via the html coding to load up your gif file. Also included in the html code is the ability to;

'1) Take away the scroll bars from the webbrowser control (There is no way to do this with the control itself!? only via html coding)

2) Resize & position the image file (see below) This is useful if you just want to view the actual gif file and NO useless white space."

Here is an example that he gives:
Download now..............

Here is the Addin to make it happen in your spreadsheet. You will also need to put the code from the example into your spreadsheet and the form.
Download now

Improving Performance in Excel 2007

http://msdn2.microsoft.com/en-us/library/aa730921.aspx

Summary: Learn about the increased worksheet capacity in Microsoft Office Excel 2007 and techniques that you can use as you design and create worksheets to improve calculation performance. (40 printed pages)

Charles Williams, Decision Models Limited

October 2006

Applies to: Microsoft Office Excel 2007, Microsoft Office Excel 2003, Microsoft Excel 2002, Microsoft Excel 2000

Contents

• Overview

• The "Big Grid" and Increased Limits in Excel 2007

• Why Is Calculation Speed Important?

• Understanding Calculation Methods in Excel

• Calculating Workbooks, Worksheets, and Ranges

• Controlling Calculation Options

• Making Workbooks Calculate Faster

• Finding and Prioritizing Calculation Bottlenecks

• Excel 2007 Performance Improvements

• Tips for Optimizing Bottlenecks

• Workbook Opening, Closing, Saving, and Size

• Conclusion

• Additional Resources

Filename in cell

http://www.ozgrid.com/forum/showthread.php?t=53472

=REPLACE(LEFT(CELL("filename",A2),FIND("]",CELL("filename",A2))-5),1,FIND("[",CELL("filename",A2)),"")

or possibly better

=MID(CELL("filename"),SEARCH("[",CELL("filename"))+1,SEARCH("]",CELL("filename"))-5-SEARCH("[",CELL("filename")))

Showing worksheet tab name in cell

=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,256)

New Custom Functions (work with highlighted cells)

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

'Last night I decided to make some custom functions to work with Conditional Formatting. They've been added to Andrew's Custom Functions which you can download here.

1. GetColor has been replaced by GetColorIndex.
2. GetFontIndex has been added.
3. ColorName has been added.

'Here's a picture of ColorName used to distinguish whether colors are Fill colors or Conditional Format colors. The "1" in Column F formulas refers to the 1st Conditional Format, if left out it refers to the Fill color. (Use "2" or "3" for the second or third Conditional Formats respectively).



'In the case of cell B12, the Fill color and the first Conditional Format color are the same, something that might be missed if not checked carefully.

'Just keep in mind that a) this function only works for the standard 56 colors and b) some color names are duplicated. Even so, it may come in handy depending on what you are using it for."

Row Highlight

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

"Some time ago, I was experimenting with automatic row highlighting using VBA and thought a separate post might be in order just in case the previous comments got missed.

'Using the Visual Basic Editor, place the following code in ThisWorkbook.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.ScreenUpdating = True
End Sub

'Then, select your range with the mouse and open Conditional Formatting from the Format menu to enter this formula.

=CELL("row")=ROW()

'This is how it looks.



'Quite simple and easy to remember. (The screen flickers a bit with larger files, it still seems to work without problems).

'Ivan F Moala of the famed Xcel Files was kind enough to show me a good alternative. It does have some drawbacks but the highlighting factor itself is improved.

Note: It was also suggested to use =OR(CELL("row")=ROW(), CELL("col")=COLUMN()) to get both active row and column on my Japanese site. The choice is yours ;-)"

Displaying AutoFilter criteria

http://j-walk.com/ss/excel/usertips/tip044.htm

"Excel's AutoFilter feature definitely ranks right up there when it comes to handy tools. This feature, which you access with the Data, Filter, AutoFilter command, works with a range of cells set up as a database or list. When AutoFiltering is turned on, the row headers display drop-down arrows that let you specify criteria (such as "Age greater than 30"). Rows that don't match your criteria are hidden, but they are redisplayed when you turn off AutoFiltering.

'One problem with AutoFiltering is that you can't tell which criteria are in effect. Stephen Bullen developed a custom VBA worksheet function that displays the current AutoFilter criteria in a cell. The instructions that follow are for Excel 97 or later.

'Press Alt+F11 and insert a new module for the active workbook. Then enter the VBA code for the FilterCriteria shown below.

Function FilterCriteria(Rng As Range) As String
   'By Stephen Bullen
   Dim Filter As String
   Filter = ""
   On Error GoTo Finish
   With Rng.Parent.AutoFilter
       If Intersect(Rng, .Range) Is Nothing Then GoTo Finish
       With .Filters(Rng.Column - .Range.Column + 1)
           If Not .On Then GoTo Finish
           Filter = .Criteria1
           Select Case .Operator
               Case xlAnd
                   Filter = Filter & " AND " & .Criteria2
               Case xlOr
                   Filter = Filter & " OR " & .Criteria2
           End Select
       End With
   End With
Finish:
   FilterCriteria = Filter
End Function

'After you've entered the VBA code, you can use the function in your formulas. The single-cell argument for the FilterCriteria function can refer to any cell within the column of interest. The formula will return the current AutoFilter criteria (if any) for the specified column. When you turn AutoFiltering off, the formulas don't display anything.

'The figure below shows the FilterCriteria in action. The function is used in the cells in row 1. For example, cell A1 contains this formula:

=FilterCriteria(A3)
 

'As you can see, the list is currently filtered to show rows in which column A contains January, column C contains a code of A or B, and column D contains a value greater than 125 (column B is not filtered, so the formula in cell B1 displays nothing). The rows that don't match these criteria are hidden."

Filter Highlight

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

"When using AutoFilter, it's quite hard to see which column is being filtered.



'This Custom Function can be used to highlight them. Enter the following code in a standard module. (Alt + F11, then Insert, Module from the top menu)

Function FilterOn(myCell As Range) As Boolean
On Error Resume Next
With myCell.Parent.AutoFilter
With .Filters(myCell.Column - .Range.Column + 1)
If .On Then FilterOn = True
End With
End With
End Function

'Then using Conditional Formatting, enter =filteron(your cell reference). (Format, Conditional Formatting, Formula Is).

'The result...



'I should mention I made the above from tinkering with this custom function by Stephen Bullen (found on the Spreadsheet Page by John Walkenbach).

Always pays to tinker... ;-)"

change a range of formulas from Absolute to Relative

http://www.ozgrid.com/News/IndirectBlanksConverFormula.htm

"This month I thought I would show you the ConvertFormula method! This method allows us to change a range of formulas from Absolute to Relative, Relative to Absolute, Relative Row to Absolute Row and so on... In fact we can change any relative or absolute aspect of any formula. The Excel help for the ConvertFormula is written as below:

'Converts cell references in a formula between the A1 and R1C1 reference styles, between relative and absolute references, or both.

---

Syntax

expression.ConvertFormula(Formula, FromReferenceStyle, ToReferenceStyle, ToAbsolute, RelativeTo)

expression Required. An expression that returns an Application object.

Formula Required Variant. A string that contains the formula you want to convert. This must be a valid formula, and it must begin with an equal sign.

FromReferenceStyle Required Long. The reference style of the formula. Can be one of the following XLReferenceStyle constants: xlA1 or xlR1C1.

ToReferenceStyle Optional Variant. The reference style you want returned. Can be one of the following XLReferenceStyle constants: xlA1 or xlR1C1. If this argument is omitted, the reference style isn't changed; the formula stays in the style specified by FromReferenceStyle.

ToAbsolute Optional Variant. Specifies the converted reference type. Can be one of the following XLReferenceType constants: xlAbsolute, xlAbsRowRelColumn, xlRelRowAbsColumn, or xlRelative. If this argument is omitted, the reference type isn't changed.

RelativeTo Optional Variant. A Range object that contains one cell. Relative references relate to this cell.

---

So with the above in mind we can easily write a simple Procedure that will change our formulas for us

---

Sub MakeAbsoluteorRelative()
'Written by OzGrid Business Applications
'www.ozgrid.com

Dim RdoRange As Range
Dim i As Integer
Dim Reply As String

'Ask whether Relative or Absolute
Reply = InputBox("Change formulas to?" & Chr(13) & Chr(13) _
& "Relative row/Absolute column = 1" & Chr(13) _
& "Absolute row/Relative column = 2" & Chr(13) _
& "Absolute all = 3" & Chr(13) _
& "Relative all = 4", "OzGrid Business Applications")

'They cancelled
If Reply = "" Then Exit Sub

On Error Resume Next
'Set Range variable to formula cells only
Set RdoRange = Selection.SpecialCells(Type:=xlFormulas)

'determine the change type
Select Case Reply
Case 1 'Relative row/Absolute column

For i = 1 To RdoRange.Areas.Count
RdoRange.Areas(i).Formula = _
Application.ConvertFormula _
(Formula:=RdoRange.Areas(i).Formula, _
FromReferenceStyle:=xlA1, _
ToReferenceStyle:=xlA1, ToAbsolute:=xlRelRowAbsColumn)
Next i

Case 2 'Absolute row/Relative column

For i = 1 To RdoRange.Areas.Count
RdoRange.Areas(i).Formula = _
Application.ConvertFormula _
(Formula:=RdoRange.Areas(i).Formula, _
FromReferenceStyle:=xlA1, _
ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsRowRelColumn)
Next i

Case 3 'Absolute all

For i = 1 To RdoRange.Areas.Count
RdoRange.Areas(i).Formula = _
Application.ConvertFormula _
(Formula:=RdoRange.Areas(i).Formula, _
FromReferenceStyle:=xlA1, _
ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsolute)
Next i

Case 4 'Relative all

For i = 1 To RdoRange.Areas.Count
RdoRange.Areas(i).Formula = _
Application.ConvertFormula _
(Formula:=RdoRange.Areas(i).Formula, _
FromReferenceStyle:=xlA1, _
ToReferenceStyle:=xlA1, ToAbsolute:=xlRelative)
Next i


Case Else 'Typo
MsgBox "Change type not recognised!", vbCritical, _
"OzGrid Business Applications"
End Select

'Clear memory
Set RdoRange = Nothing
End Sub

'The important part to note in the above Procedure is that we do not loop through all cells in the selection looking for formulas, we simply set a range variable to the SpecialCells method using xlFormulas as the Type argument. This way we are not:

1. Looping through potentially thousands of cells we are not interested in.
2. Forcing the user to select only formula cells.

I hope you can all find a use for this one, I know I certainly can and do!"

Comments Made Simple(r)

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

"Doug Glancy kindly suggested making my code run more like a regular userform in the comments of my last post.

'So this is what I came up with. Enter the text as before by pushing the OK button.



'Then choose to add another line or continue by inserting the comment.



'You can then choose to keep the comment visible or hide it from view. With a bit of practice you can enter lines and comments quite quickly. A shortcut would be a really good idea if you use it a lot.

'Here's the new code.

Sub AddComment()
On Error Resume Next
Dim cmtMsg As String, nwLne As String, LneCnt As Long, Dscn As Long
If TypeName(Selection) <> "Range" Then Exit Sub
AddLine:
nwLne = InputBox("Enter line " & LneCnt + 1 & " of your comment text." & vbNewLine & vbNewLine & _
"Leave blank or push Cancel to exit.", "Please write your comment")
If LneCnt > 0 Then cmtMsg = cmtMsg & Chr(10) & nwLne Else cmtMsg = nwLne
LneCnt = LneCnt + 1
If nwLne = "" Then
Exit Sub
Else
Dscn = MsgBox("Do you want to add another line? " & vbNewLine & vbNewLine _
& "Push No to insert the comment.", vbYesNo, "Add another line?")
If Dscn = vbYes Then GoTo AddLine
Application.ScreenUpdating = False
With ActiveCell
.ClearComments
.AddComment
With .Comment
.Visible = True
.Shape.AutoShapeType = msoShapeRoundedRectangle
.Shape.Shadow.Visible = msoFalse
.Shape.Select True
.Text Text:=cmtMsg
With Selection.ShapeRange
.Shadow.Visible = msoFalse
.ScaleHeight 0.3, msoFalse, msoScaleFromTopLeft
.Adjustments.Item(1) = 0.25
End With
.Shape.TextFrame.Autosize = True
Dscn = MsgBox("Do you want the comment to remain visible? ", _
vbYesNo, "Keep comment visible?")
If Dscn = vbNo Then .Visible = False
End With
.Select
End With
Application.ScreenUpdating = True
End If
End Sub

'Hmm...me like :-)

'Update: Andy Pope sent me a file to show an even better job can be done with a Multiline Textbox. There's no need to push buttons to add new lines, just use the Enter key. This also has a great advantage in that you see all of the text, not just one line at a time) When finished you can enter the text, by pushing Tab, Enter (This enables the Ok button to insert the comment)

'Here's a picture of it in action.



'You can download his file here.

More good code for me to study. Thanks also to Jon Peltier for suggesting the same thing."

Splashscreen

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

"Sooner or later, everyone wants to try making a splashscreen. Most that I seen so far seem be made with a userform, but I wanted to try making a very simple one using AutoShapes.



'Actually, this is a picture of two Autoshapes that have been grouped together. The Fill effects are Papyrus and Medium Wood, obtained from doube clicking the shapes while they are still separate and selecting Format AutoShape, Color and Lines, Fill Color, Fill Effects, Texture.

'Here's the code I used.

Sub SplashscreenShape()
Dim Ctr As Long
ThisWorkbook.Sheets("Sheet3").Activate
Range("A1:R41").Select
ActiveWindow.Zoom = True
Do While Ctr < 5
ActiveSheet.Shapes("Message").Select
Select Case Ctr
Case 0
Selection.Characters.Text = "CHANGE" & Chr(10) & "IT" & Chr(10) & "A" & Chr(10) & "BIT"
Case 1
Selection.Characters.Text = "WRITE" & Chr(10) & "ANYTHING" & Chr(10) & "YOU" & Chr(10) & "LIKE"
Case 2
Selection.Characters.Text = "DO" & Chr(10) & "IT" & Chr(10) & "FOR" & Chr(10) & "FUN"
Case 3
Selection.Characters.Text = "THIS" & Chr(10) & "IS" & Chr(10) & "THE" & Chr(10) & "END"
End Select
Ctr = Ctr + 1
Application.Wait Now + TimeSerial(0, 0, 2)
Loop
Application.ScreenUpdating = False
ActiveSheet.Shapes("Message").Select
Selection.Characters.Text = "PUT" & Chr(10) & "SOME" & Chr(10) & "TEXT" & Chr(10) & "HERE"
Range("IV65536").Select
ThisWorkbook.Sheets("Sheet1").Select
Application.ScreenUpdating = True
End Sub

Sub Auto_Open()
SplashscreenShape
End Sub

Sub Auto_Close()
ThisWorkbook.Close SaveChanges:=False
End Sub

'Note that I've used "ActiveWindow.Zoom". This is so the range A1:R41 is zoomed in or zoomed out automatically which helps the dimensions of the AutoShape to retain their proportions on different size screens.

Here's a sample workbook to download. Nothing brilliant, just something for my own amusement ;-)"

Timelines in Excel

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

"Jon Wittwer from the The Excel Nexus contacted me the other day regarding techniques he developed to make timelines using Excel graphs.

'This is a picture of a method used to create them very quickly. I had a look at the download file, it was quite simple and easy to use.



Here is a link to the download page. There is also some other material he wrote here. Definitely worth a look! "

More On Automatic Highlighting

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

"Earlier this week I was experimenting again with highlighting using the CELL function.

'Highlight the Active Cell
The syntax of the CELL function is CELL(info_type, [reference]), the "reference" part meaning a cell such as A1 etc.

'When the reference is omitted, the CELL function refers to the active cell. This can be readily used to highlight with some Conditional Formatting and Screen Updating.

'First navigate to the Visual Basic Editor (push Alt + F11), locate your file, then select Microsoft Excel Objects, ThisWorkbook. At the top, you will see 2 dropdown lists. Use the one on the left to select Workbook, then the one on the right to choose SheetSelectionChange. Add "Application.ScreenUpdating = True" like this.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.ScreenUpdating = True
End Sub

'Go back to Excel, select your highlight range, then from the top menu choose Format, Conditional Formatting, select Formula Is from the dropdown list and enter this formula.

=CELL("address")=ADDRESS(ROW(),COLUMN())

'Push the Format button, make a color selection from the Patterns tab, then push OK twice.

'You should get something like this.



'The address of the active cell (using CELL) equals that of the address obtained with the ROW and COLUMN functions. TRUE!

'Note: You can use Worksheet_SelectionChange instead if you want to work with just one particular sheet, enter the code in the appropriate sheet instead of This Workbook.

'Highlight the Row and Column
Last time I mentioned highlighting both the row and column like this.

=OR(CELL("row")=ROW(), CELL("col")=COLUMN())

'This results in a cross shape where the row and column overlap. I didn't feel this was the best as a visual aid (the whole purpose of the exercise) so after some experimentation, I came to the conclusion that a reverse "L" was the best (same as seen on Ivan Moala's site, The Xcel Files), in that it seems a lot easier to work with.

'Here is the appropriate conditional format (use the same steps as above)

=OR(AND(CELL("row")=ROW(),CELL("col")+1>COLUMN()),AND(CELL("col")=COLUMN(),CELL("row")+1>ROW()))

While I mention it, Ivan told me of his Hex File Reader that contains an example of the code he uses. You can study his code and gain a valuable download at the same time, far too good an opprtunity to miss ;-)"

Bar Graphs In Cells

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

"I just saw a future conditional format coming up in Excel 12 via the J-Walk Blog and thought I would try to imitate it. Note: This should work fine with Excel 2002 and 2003, I'm not sure about earlier versions but you can give it a try. (The transparency feature might not work as well though)

'Here's the real McCoy... (picture from David Gainer's Microsoft Excel blog)



'And here's the code I used with Autoshapes...

Sub BarGraphsInCells()
On Error Resume Next
Dim LoopCount As Long, BarWidth As Long, Cell As Range, theRange As Range
Set theRange = Selection
LoopCount = 1
For Each Cell In theRange
BarWidth = (ActiveCell.Value / Application.Max(theRange)) * ActiveCell.Width * 0.7 ' Adjust to suit
ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, BarWidth, ActiveCell.Height). _
Select
With Selection
.ShapeRange.Fill.ForeColor.SchemeColor = 12
.ShapeRange.Line.Visible = msoFalse
.ShapeRange.Fill.Transparency = 0.8
.Name = "The Bars" & LoopCount
End With
ActiveSheet.Shapes.Range(Array("The Bars", "The Bars" & LoopCount)).Select
Selection.ShapeRange.Group.Select
Selection.Name = "The Bars"
Cell.Offset(1).Select
LoopCount = LoopCount + 1
Next
theRange.Select
End Sub

'And the result...



Hmm, not too bad considering it's way past my bedtime. Night!"

Bar Graphs In Cells 2

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

"Continuing from my last post - I had a little spare time today so I decided to experiment a little more with the appearance. Here's my improved code to get the same kind of gradient effect as shown below (rather than just transparency)

Sub BarGraphsInCells2()
On Error Resume Next
Dim LoopCount As Long, BarWidth As Long, Cell As Range, theRange As Range
Set theRange = Selection
LoopCount = 1
For Each Cell In theRange
BarWidth = (ActiveCell.Value / Application.Max(theRange)) * ActiveCell.Width * 0.9
ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, BarWidth, ActiveCell.Height). _
Select
With Selection
.ShapeRange.Line.Visible = msoFalse
.ShapeRange.Fill.Transparency = 0.8
.ShapeRange.Fill.ForeColor.SchemeColor = 48
.ShapeRange.Fill.OneColorGradient msoGradientVertical, 2, 0.5
.Name = "The Bars" & LoopCount
End With
ActiveSheet.Shapes.Range(Array("The Bars", "The Bars" & LoopCount)).Select
Selection.ShapeRange.Group.Select
Selection.Name = "The Bars"
Cell.Offset(1).Select
LoopCount = LoopCount + 1
Next
theRange.Select
End Sub

'This seems to be getting close.



'The next trick was to add a little extra in the way of conditioning. I used CBool to get a TRUE condition, otherwise skip the part where AutoShapes are added, then go to the next step, which I very orginally named "NextStep" :-)

'Here's an example that looks for the 5 highest values using RANK (be warned that this works a little strange in the case of duplicates).

Sub BarGraphsInCells3()
On Error Resume Next
Dim LoopCount As Long, BarWidth As Long, Cell As Range, theRange As Range
Set theRange = Selection
LoopCount = 1
For Each Cell In theRange
If Not CBool(Application.Rank(Cell, theRange) <= 5) Then GoTo NextStep
BarWidth = (ActiveCell.Value / Application.Max(theRange)) * ActiveCell.Width * 0.9
ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, BarWidth, ActiveCell.Height). _
Select
With Selection
.ShapeRange.Line.Visible = msoFalse
.ShapeRange.Fill.Transparency = 0.8
.ShapeRange.Fill.ForeColor.SchemeColor = 10 'change the color here!
.ShapeRange.Fill.OneColorGradient msoGradientVertical, 2, 0.5
.Name = "The Bars" & LoopCount
End With
NextStep:
ActiveSheet.Shapes.Range(Array("The Bars", "The Bars" & LoopCount)).Select
Selection.ShapeRange.Group.Select
Selection.Name = "The Bars"
Cell.Offset(1).Select
LoopCount = LoopCount + 1
Next
theRange.Select
End Sub

'If you wanted to run the code without any extra conditions, just place an apostrophe in front of the CBool line to "deactivate" it (making it a comment instead of working code)

'Okay, let's take it a step further...first run the code to include all cells with a .ShapeRange.Fill.ForeColor.SchemeColor property of 10, then go to the Name Box and enter a new name for the grouped AutoShapes (eg "All The Bars") and push Enter. Then run the code again using a different SchemeColor (48) and use CBool to find the top 5 values as above. Enter a new name, say "The Top 5 Bars". Then let's try it again changing the CBool part to select all all values equal to or over 20 with a SchemeColor of 11. Rename to suit, "All Bars Over 20". (This renaming part is real hard work)

'If obscured, right click the last group and select Order, Send Backward. You should end up with something like this.



'Not bad for a hack (the code, not me) but as has been mentioned in my former post, not nearly as good as built-in Conditional Formatting where the colors change automatically (no code necessary). Then again the you can keep the grouped AutoShapes as "hardcopies", writing the condition may be a little simpler too depending on what you are trying to achieve. Then again, this is just one imitation format, I can only wait in anticipation to see what kind of tricks can be performed with Excel 12 ;-)

PS. Thanks Rembo for letting me know about the different row heights!"

Bar Graphs In Cells 3

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

"Today I was trying to think a way to get around the difference in transparency between Excel versions. This is a possible solution - try something else ;-)

'As you can see I simply adjusted the height - on the left, using a single color, on the right using a gradient with two colors.



'Here's the code with some comments shown to get different effects.

Sub BarGraphsInCells4()
On Error Resume Next
Dim LoopCount As Long, BarWidth As Long, Cell As Range, theRange As Range
Set theRange = Selection
LoopCount = 1
For Each Cell In theRange
BarWidth = (ActiveCell.Value / Application.Max(theRange)) * ActiveCell.Width * 0.9 ' Adjust width
ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Offset(1).Top - 1.5, BarWidth, 1.5). _
Select
With Selection
.ShapeRange.Line.Visible = msoFalse ' remove to show lines
.ShapeRange.Fill.ForeColor.SchemeColor = 48 ' change color to suit
.ShapeRange.Fill.BackColor.SchemeColor = 11 'remove for a single color, change color to suit
.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 1 'remove for no gradient
.ShapeRange.Height = 2
.Name = "The Bars" & LoopCount
End With
NextStep:
ActiveSheet.Shapes.Range(Array("The Bars", "The Bars" & LoopCount)).Select
Selection.ShapeRange.Group.Select
Selection.Name = "The Bars"
Cell.Offset(1).Select
LoopCount = LoopCount + 1
Next
theRange.Select
End Sub

'One advantage is you can enter into the cells a lot easier than before. If you want to see the code run automatically, select a range, type a name in the Name Box and push Enter (I've used "MyRange" in this case). Then enter this code in the appropriate sheet under Microsoft Excel Objects in the Visual Basic Editor.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.ScreenUpdating = False
If Not Intersect(ActiveCell, Range("MyRange")) Is Nothing Then
Shapes("The Bars").Delete
Range("MyRange").Select
BarGraphsInCells4
Target.Select
End If
Application.ScreenUpdating = True
End Sub

Keep in mind calculation may be slowed down somewhat. Use accordingly :-)"

Putting file drive location in the title bar

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

"Colo showed me how to use an Application Event when I was making Cell Spotter. Rather than apply to just one worksheet or workbook, the application level DoubleClick event that Cell Spotter uses applies to all open workbooks.

'So I was thinking the other day how I could use this to show file locations in the title bar when I open workbooks. (The Full Name gets a bit long and won't always fit inside the title bar, so I just settled for the drive where the file is stored)

'Here's to how to do it.

'First go to the Visual Basic Editor. (Push the Alt + F11 keys) Then add a standard module and insert this code.

Public XL As New ShowDrive

Private Sub Auto_Open()
Set XL.App = Application
End Sub

'Then add a Class Module and add this code. (The Class Module name must be the same as after where it says "New" in the code above - in this case "ShowDrive")

Public WithEvents App As Excel.Application

Private Sub App_WorkbookOpen(ByVal Wb As Excel.Workbook)
On Error Resume Next
If Wb.Name <> "PERSONAL.XLS" Then _
ActiveWindow.Caption = Left(Wb.FullName, 2) & " " & Wb.Name
End Sub

'Note this code only works if the workbook is saved (New workbooks don't really have full names until they are saved, also the Personal.xls file has been coded out using If...Then...)

'Hmm, this works fine but a problem occurs when the file is saved. If the drive is different I won't have any way of checking if the drive has changed because a BeforeSave event can't be used in this case, not as far as I know anyway :-)

'So I added this SelectionChange code instead. This works when other cells are selected so it should work assuming you select some cells after saving.

'Make sure it's placed in the class module too.

Private Sub App_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
On Error Resume Next
If Len(Application.Substitute(Sh.Parent.Name, ".xls", "")) <> Len(Sh.Parent.Name) Then _
ActiveWindow.Caption = Left(Sh.Parent.FullName, 2) & " " & Sh.Parent.Name
End Sub

'Now for the final step. Close the Visual Basic Editor, then save the workbook as an add-in by selecting Save As from the File Menu, then Microsoft Excel Add-In from the "Save as type:" drop down list under where it says "File name:".

'Go to Tools, Add-Ins and install it. (Use the Browse button to find add-ins not shown in the list)

Keep in mind the ShowDrive class module is where the event code works, you can adjust it to do whatever you like ;-)"

BeforeSave only with Save, not Save As

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

I see this question asked a few times and just as often answered...anyway I figure I'd include it here too.

Q. When you use a BeforeSave event, is there a way to stop it from firing when using Save As?

A. Yep, use a variation of this code. This example asks the user whether they really want to save, ie they have pushed Save, not Save As which you use to give a workbook a (new) filename.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI = False Then
If MsgBox("Do you really want to save this Workbook? ", vbYesNo) = vbNo Then
Cancel = True
Exit Sub
End If
End If
End Sub

It's the SaveAsUI part that exits the sub. Keep in mind that the code also exits when working with unsaved workbooks, saving them would involve using a new filename (ie Save As).

Quick Write: Me: 1, Registry: 0

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

I've been practicing using the registry over the last couple of days. What I've done is make a new version of Quick Paste called Quick Write, it's essentially the same thing except that Quick Write does not use values in cells, and does not save when uninstallling or quitting Excel. Rather, the values are stored between sessions in the registry.



I've found this to be a much better method overall, not to mention some nice practice in learning some new code.

Here's the link. You can launch it from the Right Click menu.

Update: I found a potential bug that has hopefully been fixed. Please download the new version from the above link.

New Cell Spotter

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

Today I modified the code for Cell Spotter.



As you can see some extra items have been added to the menu. In addition to the lines that appear when you double-click cells, you can also use "Highlight" to make the same type of lines appear around multiple selections - the cells are determined by selecting them with the mouse. Unlike the regular Cell Spotter lines, these lines don't disappear automatically unless you choose to delete them.



Also, the line color(s) and thickness can be altered by changing "Settings".

And finally, you can choose to turn Cell Spotter on or off as convenient. Any changes made (including "Settings") are recorded in the registry.

A little early for Christmas but I hope you like it. The link is here.

Day and Date Calculator

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

Here's something I was playing with over the break. (Thanks to my trusty tester Remco :-))

Day and Date Calculator
You can subtract dates. (The difference between the 2 dates is shown under the "Years, Month, Day" and "Weeks, Day" labels which adjust automatically. Note: The Upper Date must be higher than the Lower Date)



Or calculate dates. (Enter either positive or negative numbers in the textboxes where applicable. The "Calculated Date" label also updates automatically)



Pre-1900 Dates
Notice the lower date from the first image that is shown is Year 100. Dates from Year 100 January 1 until Year 9999 November 30 can be used for both Subtract Dates and Calculate Dates.

Here's a link to download from.

Visibility In Excel Part 1 - Dynamic Comments

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

It occurred to me the other day that visibility in spreadsheet design is not always the best. This may be due to several reasons, the fact is key data may not be readily accessible when needed - it could be in hidden rows or columns, not visible on the current screen or perhaps in another sheet or workbook.

This is a possible solution using Input Messages from Data Validation combined with a Selection Change event. An example workbook is attached for your reference here. And below is an image of a "Dynamic Comment" in action. (By "Dynamic Comments", I mean comments that update automatically. Select the cell where they show, and the latest data will be updated instantly)



A bit of explanation on how it is set up. Here is the example code.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Cells(1, 1) = False Then Exit Sub
With Target
If .Column = 2 And _
.Row > 2 And _
.Row < ActiveSheet.UsedRange.Row + _
ActiveSheet.UsedRange.Rows.Count Then
.EntireColumn.Validation.Delete
With .Validation
.Add Type:=xlValidateInputOnly
.InputTitle = "" ' Optional
.InputMessage = "Customer: " & Cells(Target.Row, 2) & Chr(10) & _
"Invoice Number: " & Cells(Target.Row, 14) & Chr(10) & _
"Item Ordered: " & Cells(Target.Row, 6) & Chr(10) & _
"Quantity: " & Format(Cells(Target.Row, 12), "#,##0") & Chr(10) & _
"Amount: " & Format(Cells(Target.Row, 16), "$ #,##0.00") & Chr(10) & _
"Total Sales: " & Format(Application.Sum(Range("TotalSales")), "$ #,##0.00")
End With
End If
End With
End Sub

1. Automatic Update Mode vs. Edit Mode
First, you will notice that if Cells(1,1) (Range A1) is False, the subroutine is exited. This added to make it possible to edit the worksheet without the SelectionChange event interfering with Undo. The Forms Toolbar checkbox you can see is linked to Range A1, the font is not visible as I have changed the color to White but you can see whether the code is enabled or not by looking at the Checkbox. When checked, A1 is TRUE (Automatic Update Mode), otherwise it is FALSE (Edit Mode). If you are just referring to data rather than editing (or you feel comfortable without Undo), you might want to just leave it in Automatic Update Mode all of the time.

2. Set the Range
I've limited the range to just once cell in one column (In this case Column B). It might be tempting to add more columns or rows and there is nothing to stop you, I prefer to limit the validation to keep the file size down.

3. The Input Message
This is where it all happens. I've made a string to join data from several cells. The input message in this case is just an example. It probably would not be necessary to show data from cells that are already visible. So you can use the "comments" to refer to where you can't see... as mentioned above, hidden rows or columns, not visible on the current screen or in another sheet or workbook, even outside of Excel (for example, the Registry). Not only that, you can use VBA to make calculations to add to the string and also format it as you like.

A few things to keep in mind,

There is a limit of characters that can be used in the Input Messages (254 by my testing)

I've used Chr(10) to force linebreaks. It doesn't always work as expected, but you can add an extra row of characters at the bottom to help. The number of of characters used in this case should exceed the maximum number of characters used in any other row.

An easy way to get the Column numbers is to go to Tools, Options, General, then check R1C1 reference style to show the numbers in the Column Headers. Uncheck when finished.

Why not use regular comments? I experimented using them - I found this way to work better.

Visibility In Excel Part 3 User Friendly Rows

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

Excel is vertical-centric (Okay, I made this word up)

Don't believe me? The user interface is mostly at the top or bottom - Main menu at the top, Autofilter at the top, Name Box and Formula Bar at the top, Status Bar at the bottom, Sheet tabs at the bottom...why is it so? I guess the reason is that it is a lot easier to work "vertically" than "horizontally", even mouse wheels are designed to work this way.

Which leads to a problem with rows. Looking at several rows with data, it's easy to lose track of which row you are supposed to be looking at. So here are a few tips to make life easier.

1. Increase the row height
If this does not interfere with how your files are set up, changing row heights to somewhere between 18 and 24 points will help reduce eyestrain.

Before (14.25 points)


After (18.00 points)


Easier to see with just a minor change in row height.

2. Row Shading
Changing the color of every other row helps too. You can just change the Fill color, or use Conditional Formatting. (This has the advantage of chaning the row color if you decide to insert more rows later on)

Here's a link to one of my old posts.

My preferred formats are

=ODD(ROW())=ROW()

or

=EVEN(ROW())=ROW()

mainly because they are simple to remember...

The difference?



Getting better again.

3. Automatic row highlight
This is some code I wrote a week or so ago. Place it in the appropiate sheet module and change the top left cell and bottom right cell of your range to suit where indicated.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1") = False Then Exit Sub ' Optional
On Error Resume Next
Dim myRange As Range
Dim myTopLeftCell As Range
Dim myBottomRightCell As Range

' Set your Top Left Cell and Bottom Right Cell, (Range Names can be used also)
' ****************************************************************
Set myTopLeftCell = Range("B2")
Set myBottomRightCell = Range("H20")
' ****************************************************************

If Target.Row >= myTopLeftCell.Row And _
Target.Offset(Selection.Rows.Count - 1).Row <= myBottomRightCell.Row And _ Target.Column >= myTopLeftCell.Column And _
Target.Offset(, Selection.Columns.Count - 1).Column <= myBottomRightCell.Column Then Set myRange = Selection If ActiveSheet.Shapes("hSelection") Is Nothing Then ActiveSheet.Shapes.AddShape(msoShapeRectangle, myTopLeftCell.Left, Selection.Top, _ myBottomRightCell.Offset(, 1).Left - _ myTopLeftCell.Left, Selection.Height).Select With Selection With .ShapeRange .Fill.Visible = msoFalse .Line.ForeColor.SchemeColor = 12 ' Change Color Here .Line.Weight = 2.25 ' Change Line Weight (Thickness) Here .ZOrder msoSendToBack .Shadow.Visible = msoFalse End With .Name = "hSelection" .PrintObject = False End With Else With ActiveSheet.Shapes("hSelection") .Left = myTopLeftCell.Left .Top = Selection.Top .Width = myBottomRightCell.Offset(, 1).Left - myTopLeftCell.Left .Height = Selection.Height .ShapeRange.Shadow.Visible = msoFalse End With End If myRange.Select End If Set myTopLeftCell = Nothing Set myBottomRightCell = Nothing Set myRange = Nothing End Sub

Like my previous Data Validation code, it assumes that there is a Forms Toolbar checkbox in Cell A1 (Turn it the checkbox on and off to stop the code from running, it tends to interfere with Undo)

Here's some code to quickly insert a Checkbox.

Sub AddCheckbox()
On Error Resume Next
ActiveSheet.CheckBoxes.Add(0, 0, 0, 0).Select
With Selection
.Characters.Text = ""
.Value = xlOn
.LinkedCell = "A1"
End With
Range("A1").Select
Selection.Font.ColorIndex = 2
End Sub

With the Checkbox turned on, you are ready to go. Select any cell within the range and the row is highlighted accordingly.

Here's a pic.



I've also been working on a new version of my Cell Spotter to work in a similar way. Just now I'm testing it at work, I'll upload it when it's ready :-)