I'm trying to create an automated seating chart. I'd like to use the
"vlookup" function to display the student's picture in the appropriate
location on the chart just as I'm using "vlookup" to display the student's
name.

mosik

Check out John McGimpsey's site...

http://www.mcgimpsey.com/excel/lookuppics.html


Gord Dibben MS Excel MVP

On Mon, 14 Aug 2006 21:36:32 -0700, rnosik
wrote:

I'm trying to create an automated seating chart. I'd like to use the
"vlookup" function to display the student's picture in the appropriate
location on the chart just as I'm using "vlookup" to display the student's
name.

Gord Dibben MS Excel MVP

I am trying to perform a similar task and am a VB novice. I can't get this
to work for my situation. Can you provide some extra info?

Thanks,

"Gord Dibben" wrote:

mosik

Check out John McGimpsey's site...

http://www.mcgimpsey.com/excel/lookuppics.html


Gord Dibben MS Excel MVP

On Mon, 14 Aug 2006 21:36:32 -0700, rnosik
wrote:

I'm trying to create an automated seating chart. I'd like to use the
"vlookup" function to display the student's picture in the appropriate
location on the chart just as I'm using "vlookup" to display the student's
name.

Gord Dibben MS Excel MVP

Daigle wrote:
I am trying to perform a similar task and am a VB novice. I can't get this
to work for my situation. Can you provide some extra info?

Thanks,

Hi Daigle,

Can you gives some detail about your situation?

Ken Johnson

I am trying to create a table that shows images (shaded pies: no
shade,1/4,1/2,3/4,full shade) to represent progress on measures hitting
targets. We have these five images that would be referenced in a table with
multiple columns and multiple rows.

Thanks!

"Ken Johnson" wrote:


Daigle wrote:
I am trying to perform a similar task and am a VB novice. I can't get this
to work for my situation. Can you provide some extra info?

Thanks,

Hi Daigle,

Can you gives some detail about your situation?

Ken Johnson

Daigle wrote:
I am trying to create a table that shows images (shaded pies: no
shade,1/4,1/2,3/4,full shade) to represent progress on measures hitting
targets. We have these five images that would be referenced in a table with
multiple columns and multiple rows.

Thanks!

Hi Daigles,

Is my interpretation of your situation correct?

You want each cell in your table of multiple rows and columns to be
able to show one of five mini piechart pictures, where the one that is
displayed depends on the value in the same cell.

Ken Johnson

Hi Daigles,

Assuming my assumption is correct, here is one way...

Range(B2:D11) is the table.
The mini pie charts have been named "None", "Quarter", "Half",
"ThreeQuarters" and "Full"
by selecting each separately, typing the name in the Name box on the
left of the Formula bar, then pressing Enter.

The following Worksheet_Change code is fired when ever one or more
cells in the table (B2:D11) has its value changed. The code first
deletes any shape in the cell that was used to illustrate the previous
value of that cell. Then the shape illustrating the cells new value is
copied and pasted into the cell. The copied shape is then named
according to the address of the cell into which it has been pasted.
Shapes can't be given a name that resembles a cell range address so the
name used is the tilde character (~) followed by the cell's address eg
~$C$8. This makes it easy to delete the shape next time the cell's
value changes.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2:D11")) Is Nothing Then
Application.ScreenUpdating = False
Dim rngCell As Range
Dim strPie As String
For Each rngCell In Intersect(Target, Range("B2:D11"))
On Error Resume Next
Me.Shapes("~" & rngCell.Address).Delete
On Error GoTo 0
Select Case rngCell.Value
Case 0
strPie = "None"
Case 0.25
strPie = "Quarter"
Case 0.5
strPie = "Half"
Case 0.75
strPie = "ThreeQuarters"
Case 1
strPie = "Full"
End Select
If strPie < "" Then
Me.Shapes(strPie).Copy
Range(rngCell.Address).PasteSpecial
Selection.Name = "~" & rngCell.Address
End If
Next rngCell
Target.Cells(Target.Cells.Count).Select
End If
End Sub

If you have trouble adapting this to your situation let me know.

Ken Johnson

Hi Daigles,

I think I understand your problem now.
It's in the heading of your post!
You're using a formula to reference the desired image and the change in
the formula's value (resulting from a sheet calculation) is not
detected by Excel as a Worksheet_Change event so nothing happens.
If that is the case then you need to use the Worksheet_Calculate event
instead.

The following code acts on a table consisting of the range $B$2:$D$11
as before.
The five pie images (I just used grouped autoshapes to make mine) are
present on the same sheet (they can be part of a legend) and they have
been given the names "None", "Quarter", "Half", ThreeQuarters" and
"Full" (as before).
Everytime the Worksheet is calculated all the old pie images in the
table are deleted then replaced with a new image depending on the value
in the cell.
Blank cells, cells with negative values and cells with a value greater
than 1 receive no image.
Cells with a value greater than or equal to 0 and less than 0.125
receive the "None" pie
Cells with a value greater than or equal to 0.125 and less than 0.375
receive the "Quarter" pie
Cells with a value greater than or equal to 0.375 and less than 0.625
receive the "Half" pie
Cells with a value greater than or equal to 0.625 and less than 0.875
receive the "ThreeQuarter" pie
Cells with a value greater than or equal to 0.875 and less than or
equal to 1 receive the "Full" pie.
I've made it easy for you to control the positioning of the image in
the cell. At the top of the code there are two string constants,
strHorizontal and strVertical. Edit their values to suit you needs. You
do not have to worry about the case used when setting these values, but
make sure the spelling is correct (I have used the American English
spelling for "Center" even though my version of the English language
(Australian English) spells it "Centre").

Again, if you have any problems adapting the code to your needs let me
know.

Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
'Edit the value of strHorizontal depending
'on where you want the Pie image to be
'horizontally positioned in the cell.
'Values used by the code are...
'"Left", "Center" or "Right" (not case sensitive)
Const strHorizontal As String = "right"
'Edit the value of strVertical depending
'on where you want the Pie image to be
'Vertically positioned in the cell.
'Values used by the code are...
'"Top", "Center" or "Bottom" (not case sensitive)
Const strVertical As String = "bottom"
Dim iHorizontal As Single
Dim iVertical As Single
Select Case UCase(strHorizontal)
Case "LEFT"
iHorizontal = 0
Case "CENTER"
iHorizontal = 0.5
Case "RIGHT"
iHorizontal = 1
End Select
Select Case UCase(strVertical)
Case "TOP"
iVertical = 0
Case "CENTER"
iVertical = 0.5
Case "BOTTOM"
iVertical = 1
End Select
Dim strActiveCellAddress As String
strActiveCellAddress = ActiveCell.Address
Dim rngCell As Range
Dim strPie As String
Dim ShpPie As Shape
For Each rngCell In Range("B2:D11")
On Error Resume Next
Me.Shapes("~" & rngCell.Address).Delete
strPie = ""
On Error GoTo 0
Select Case rngCell.Value
Case ""
Case Is < 0
Case Is < 0.125
strPie = "None"
Case Is < 0.375
strPie = "Quarter"
Case Is < 0.625
strPie = "Half"
Case Is < 0.875
strPie = "ThreeQuarters"
Case Is <= 1
strPie = "Full"
End Select
If strPie < "" Then
Me.Shapes(strPie).Copy
Range(rngCell.Address).PasteSpecial
Selection.Name = "~" & rngCell.Address
Set ShpPie = Me.Shapes("~" & rngCell.Address)
ShpPie.Left = rngCell.Left + _
iHorizontal * (rngCell.Width - ShpPie.Width)
ShpPie.Top = rngCell.Top + _
iVertical * (rngCell.Height - ShpPie.Height)
End If
Next rngCell
Range(strActiveCellAddress).Select
End Sub

Ken Johnson

Yes, this is a correct interpretation. I'll try your suggestions and see
what I can make work. How did you find them under group autoshapes?

Daigle

"Ken Johnson" wrote:


Daigle wrote:
I am trying to create a table that shows images (shaded pies: no
shade,1/4,1/2,3/4,full shade) to represent progress on measures hitting
targets. We have these five images that would be referenced in a table with
multiple columns and multiple rows.

Thanks!

Hi Daigles,

Is my interpretation of your situation correct?

You want each cell in your table of multiple rows and columns to be
able to show one of five mini piechart pictures, where the one that is
displayed depends on the value in the same cell.

Ken Johnson

This did work? Is there a way to make it center the graphic in the cell?
It's okay (even preferred) if it hides the value.

"Ken Johnson" wrote:


Daigle wrote:
I am trying to create a table that shows images (shaded pies: no
shade,1/4,1/2,3/4,full shade) to represent progress on measures hitting
targets. We have these five images that would be referenced in a table with
multiple columns and multiple rows.

Thanks!

Hi Daigles,

Is my interpretation of your situation correct?

You want each cell in your table of multiple rows and columns to be
able to show one of five mini piechart pictures, where the one that is
displayed depends on the value in the same cell.

Ken Johnson

Using a combination of your two posts, I was able to make this work. Thank
you so much! You've saved our company a great deal of time!

"Ken Johnson" wrote:

Hi Daigles,

I think I understand your problem now.
It's in the heading of your post!
You're using a formula to reference the desired image and the change in
the formula's value (resulting from a sheet calculation) is not
detected by Excel as a Worksheet_Change event so nothing happens.
If that is the case then you need to use the Worksheet_Calculate event
instead.

The following code acts on a table consisting of the range $B$2:$D$11
as before.
The five pie images (I just used grouped autoshapes to make mine) are
present on the same sheet (they can be part of a legend) and they have
been given the names "None", "Quarter", "Half", ThreeQuarters" and
"Full" (as before).
Everytime the Worksheet is calculated all the old pie images in the
table are deleted then replaced with a new image depending on the value
in the cell.
Blank cells, cells with negative values and cells with a value greater
than 1 receive no image.
Cells with a value greater than or equal to 0 and less than 0.125
receive the "None" pie
Cells with a value greater than or equal to 0.125 and less than 0.375
receive the "Quarter" pie
Cells with a value greater than or equal to 0.375 and less than 0.625
receive the "Half" pie
Cells with a value greater than or equal to 0.625 and less than 0.875
receive the "ThreeQuarter" pie
Cells with a value greater than or equal to 0.875 and less than or
equal to 1 receive the "Full" pie.
I've made it easy for you to control the positioning of the image in
the cell. At the top of the code there are two string constants,
strHorizontal and strVertical. Edit their values to suit you needs. You
do not have to worry about the case used when setting these values, but
make sure the spelling is correct (I have used the American English
spelling for "Center" even though my version of the English language
(Australian English) spells it "Centre").

Again, if you have any problems adapting the code to your needs let me
know.

Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
'Edit the value of strHorizontal depending
'on where you want the Pie image to be
'horizontally positioned in the cell.
'Values used by the code are...
'"Left", "Center" or "Right" (not case sensitive)
Const strHorizontal As String = "right"
'Edit the value of strVertical depending
'on where you want the Pie image to be
'Vertically positioned in the cell.
'Values used by the code are...
'"Top", "Center" or "Bottom" (not case sensitive)
Const strVertical As String = "bottom"
Dim iHorizontal As Single
Dim iVertical As Single
Select Case UCase(strHorizontal)
Case "LEFT"
iHorizontal = 0
Case "CENTER"
iHorizontal = 0.5
Case "RIGHT"
iHorizontal = 1
End Select
Select Case UCase(strVertical)
Case "TOP"
iVertical = 0
Case "CENTER"
iVertical = 0.5
Case "BOTTOM"
iVertical = 1
End Select
Dim strActiveCellAddress As String
strActiveCellAddress = ActiveCell.Address
Dim rngCell As Range
Dim strPie As String
Dim ShpPie As Shape
For Each rngCell In Range("B2:D11")
On Error Resume Next
Me.Shapes("~" & rngCell.Address).Delete
strPie = ""
On Error GoTo 0
Select Case rngCell.Value
Case ""
Case Is < 0
Case Is < 0.125
strPie = "None"
Case Is < 0.375
strPie = "Quarter"
Case Is < 0.625
strPie = "Half"
Case Is < 0.875
strPie = "ThreeQuarters"
Case Is <= 1
strPie = "Full"
End Select
If strPie < "" Then
Me.Shapes(strPie).Copy
Range(rngCell.Address).PasteSpecial
Selection.Name = "~" & rngCell.Address
Set ShpPie = Me.Shapes("~" & rngCell.Address)
ShpPie.Left = rngCell.Left + _
iHorizontal * (rngCell.Width - ShpPie.Width)
ShpPie.Top = rngCell.Top + _
iVertical * (rngCell.Height - ShpPie.Height)
End If
Next rngCell
Range(strActiveCellAddress).Select
End Sub

Ken Johnson

Daigle wrote:
This did work? Is there a way to make it center the graphic in the cell?
It's okay (even preferred) if it hides the value.


Hi Daigles,

I gather from your most recent post that you've got everything working.
I assume you got the image centred by editing the values of the two
string variables at the top of my most recent code...

strVertical = "center"
strHorizontal = "center"

I also assume that you have achieved your preferred option of hiding
the cell value by formatting your cells so that their vertical and
horizontal alignments are also both center

How did you find them under group autoshapes?

When I said "(I just used grouped autoshapes to make mine)" what I
meant was I positioned an msoShapeArc with a black fill (90° for
Quarter, 180° for Half and 270° for ThreeQuarter) over an
msoShapeOval (circle) then grouped the two autoshapes to make the
mini-piecharts. For None I just used an msoShapeOval (circle) with a
white fill, and the same with a black fill for Full.

Ken Johnson

Yes, I did get it to work, centering and hiding text. Thanks!

"Ken Johnson" wrote:

Daigle wrote:
This did work? Is there a way to make it center the graphic in the cell?
It's okay (even preferred) if it hides the value.


Hi Daigles,

I gather from your most recent post that you've got everything working.
I assume you got the image centred by editing the values of the two
string variables at the top of my most recent code...

strVertical = "center"
strHorizontal = "center"

I also assume that you have achieved your preferred option of hiding
the cell value by formatting your cells so that their vertical and
horizontal alignments are also both center

How did you find them under group autoshapes?

When I said "(I just used grouped autoshapes to make mine)" what I
meant was I positioned an msoShapeArc with a black fill (90° for
Quarter, 180° for Half and 270° for ThreeQuarter) over an
msoShapeOval (circle) then grouped the two autoshapes to make the
mini-piecharts. For None I just used an msoShapeOval (circle) with a
white fill, and the same with a black fill for Full.

Ken Johnson

Daigle wrote:
Yes, I did get it to work, centering and hiding text. Thanks!

You're welcome Daigles.
Thanks for the feedback.

Ken Johnson

Ken:

How would I modify this so that the range in question on sheet 2 was
changing based on a calculation taking place on sheet 1 (target cells are an
average of values on sheet 1). So once I change a value on sheet 1, I'd want
the symbols to update based on the newly calculated average?

Thanks!

"Ken Johnson" wrote:


Daigle wrote:
Yes, I did get it to work, centering and hiding text. Thanks!

You're welcome Daigles.
Thanks for the feedback.

Ken Johnson

Daigle wrote:

Ken:

How would I modify this so that the range in question on sheet 2 was
changing based on a calculation taking place on sheet 1 (target cells are an
average of values on sheet 1). So once I change a value on sheet 1, I'd want
the symbols to update based on the newly calculated average?

Thanks!

"Ken Johnson" wrote:


Daigle wrote:
Yes, I did get it to work, centering and hiding text. Thanks!

You're welcome Daigles.
Thanks for the feedback.

Ken Johnson


Hi Daigles,

I set up a workbook with tables of values on sheet 1 and a table on
sheet 2 with the average formula referring to sheet 1 values plus the
pie images. When I changed the sheet 1 values I got an error message
that referred to this line in the sheet 2 code...

Selection.Name = "~" & rngCell.Address

I suppose that is because at the time, sheet 2 is not the active sheet
and the selection is always what ever is selected on the active sheet.

I'm guessing that you also encountered this problem, though I could be
wrong.

The solution to that problem is for the code to...

1. Note the name of the active sheet. This is done using a new variable
for storing the active sheet's name. I used strActiveSheet.
2. Activate sheet 2, the sheet with the pie image manipulating code.
That is done by adding the line...

Me.activate

3.After all the pie image manipulating code is done, reactivate the
originally active sheet with the very final line...

Sheets(strActiveSheet).Activate

Because ScreenUpdating is turned off you don't see any of the sheet
changes occur, except for one quick flicker of the screen, and when you
go to sheet 2 you will see that the new pie images are in place.

In a previous post you stated that you got things working using a
combination of my posts.
I therefore don't know the exact details of your final solution,
however, you might be able to figure out what to do if I give you my
solution as it applies to my most recent post...

Option Explicit


Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
'next 3 lines of code are the first part of
'the solution to the "average of values
'on other sheet" problem
Dim strActiveSheet As String
strActiveSheet = ActiveSheet.Name
Me.Activate
'Edit the value of strHorizontal depending
'on where you want the Pie image to be
'horizontally positioned in the cell.
'Values used by the code are...
'"Left", "Center" or "Right" (not case sensitive)
Const strHorizontal As String = "center"
'Edit the value of strVertical depending
'on where you want the Pie image to be
'Vertically positioned in the cell.
'Values used by the code are...
'"Top", "Center" or "Bottom" (not case sensitive)
Const strVertical As String = "center"
Dim iHorizontal As Single
Dim iVertical As Single
Select Case UCase(strHorizontal)
Case "LEFT"
iHorizontal = 0
Case "CENTER"
iHorizontal = 0.5
Case "RIGHT"
iHorizontal = 1
End Select
Select Case UCase(strVertical)
Case "TOP"
iVertical = 0
Case "CENTER"
iVertical = 0.5
Case "BOTTOM"
iVertical = 1
End Select
Dim strActiveCellAddress As String
strActiveCellAddress = ActiveCell.Address
Dim rngCell As Range
Dim strPie As String
Dim ShpPie As Shape
For Each rngCell In Range("B2:D11")
On Error Resume Next
Me.Shapes("~" & rngCell.Address).Delete
strPie = ""
On Error GoTo 0
Select Case rngCell.Value
Case ""
Case Is < 0
Case Is < 0.125
strPie = "None"
Case Is < 0.375
strPie = "Quarter"
Case Is < 0.625
strPie = "Half"
Case Is < 0.875
strPie = "ThreeQuarters"
Case Is <= 1
strPie = "Full"
End Select
If strPie < "" Then
Me.Shapes(strPie).Copy
Range(rngCell.Address).PasteSpecial
Selection.Name = "~" & rngCell.Address
Set ShpPie = Me.Shapes("~" & rngCell.Address)
ShpPie.Left = rngCell.Left + _
iHorizontal * (rngCell.Width - ShpPie.Width)
ShpPie.Top = rngCell.Top + _
iVertical * (rngCell.Height - ShpPie.Height)
End If
Next rngCell
Range(strActiveCellAddress).Select
'next line of code is the last part of the solution
'to the "average of values on other sheet" problem
Sheets(strActiveSheet).Activate
End Sub

Let me know how you go.

Ken Johnson

Hi Daigles,

I've encountered a new error that occurs when you have other workbooks
open at the same time.

My solution to this new problem is to add one extra line of code so
that the Sub is exited when ever calculation is triggered by another
open workbook...

Private Sub Worksheet_Calculate()
If Me.Parent.Name < ActiveSheet.Parent.Name Then Exit Sub
Application.ScreenUpdating = False
'next 3 lines of code are the first part of
'the solution to the "average of values
'on other sheet" problem
Dim strActiveSheet As String
strActiveSheet = ActiveSheet.Name
Me.Activate
'Edit the value of strHorizontal depending
'on where you want the Pie image to be
'horizontally positioned in the cell.
'Values used by the code are...
'"Left", "Center" or "Right" (not case sensitive)
Const strHorizontal As String = "center"
'Edit the value of strVertical depending
'on where you want the Pie image to be
'Vertically positioned in the cell.
'Values used by the code are...
'"Top", "Center" or "Bottom" (not case sensitive)
Const strVertical As String = "center"
Dim iHorizontal As Single
Dim iVertical As Single
Select Case UCase(strHorizontal)
Case "LEFT"
iHorizontal = 0
Case "CENTER"
iHorizontal = 0.5
Case "RIGHT"
iHorizontal = 1
End Select
Select Case UCase(strVertical)
Case "TOP"
iVertical = 0
Case "CENTER"
iVertical = 0.5
Case "BOTTOM"
iVertical = 1
End Select
Dim strActiveCellAddress As String
strActiveCellAddress = ActiveCell.Address
Dim rngCell As Range
Dim strPie As String
Dim ShpPie As Shape
For Each rngCell In Range("B2:D11")
On Error Resume Next
Me.Shapes("~" & rngCell.Address).Delete
strPie = ""
On Error GoTo 0
Select Case rngCell.Value
Case ""
Case Is < 0
Case Is < 0.125
strPie = "None"
Case Is < 0.375
strPie = "Quarter"
Case Is < 0.625
strPie = "Half"
Case Is < 0.875
strPie = "ThreeQuarters"
Case Is <= 1
strPie = "Full"
End Select
If strPie < "" Then
Me.Shapes(strPie).Copy
Range(rngCell.Address).PasteSpecial
Selection.Name = "~" & rngCell.Address
Set ShpPie = Me.Shapes("~" & rngCell.Address)
ShpPie.Left = rngCell.Left + _
iHorizontal * (rngCell.Width - ShpPie.Width)
ShpPie.Top = rngCell.Top + _
iVertical * (rngCell.Height - ShpPie.Height)
End If
Next rngCell
Range(strActiveCellAddress).Select
'next line of code is the last part of the solution
'to the "average of values on other sheet" problem
Sheets(strActiveSheet).Activate
End Sub

Ken Johnson

This seems to be working fine. I haven't gotten any errors. Thanks for all
your help!

"Ken Johnson" wrote:

Hi Daigles,

I've encountered a new error that occurs when you have other workbooks
open at the same time.

My solution to this new problem is to add one extra line of code so
that the Sub is exited when ever calculation is triggered by another
open workbook...

Private Sub Worksheet_Calculate()
If Me.Parent.Name < ActiveSheet.Parent.Name Then Exit Sub
Application.ScreenUpdating = False
'next 3 lines of code are the first part of
'the solution to the "average of values
'on other sheet" problem
Dim strActiveSheet As String
strActiveSheet = ActiveSheet.Name
Me.Activate
'Edit the value of strHorizontal depending
'on where you want the Pie image to be
'horizontally positioned in the cell.
'Values used by the code are...
'"Left", "Center" or "Right" (not case sensitive)
Const strHorizontal As String = "center"
'Edit the value of strVertical depending
'on where you want the Pie image to be
'Vertically positioned in the cell.
'Values used by the code are...
'"Top", "Center" or "Bottom" (not case sensitive)
Const strVertical As String = "center"
Dim iHorizontal As Single
Dim iVertical As Single
Select Case UCase(strHorizontal)
Case "LEFT"
iHorizontal = 0
Case "CENTER"
iHorizontal = 0.5
Case "RIGHT"
iHorizontal = 1
End Select
Select Case UCase(strVertical)
Case "TOP"
iVertical = 0
Case "CENTER"
iVertical = 0.5
Case "BOTTOM"
iVertical = 1
End Select
Dim strActiveCellAddress As String
strActiveCellAddress = ActiveCell.Address
Dim rngCell As Range
Dim strPie As String
Dim ShpPie As Shape
For Each rngCell In Range("B2:D11")
On Error Resume Next
Me.Shapes("~" & rngCell.Address).Delete
strPie = ""
On Error GoTo 0
Select Case rngCell.Value
Case ""
Case Is < 0
Case Is < 0.125
strPie = "None"
Case Is < 0.375
strPie = "Quarter"
Case Is < 0.625
strPie = "Half"
Case Is < 0.875
strPie = "ThreeQuarters"
Case Is <= 1
strPie = "Full"
End Select
If strPie < "" Then
Me.Shapes(strPie).Copy
Range(rngCell.Address).PasteSpecial
Selection.Name = "~" & rngCell.Address
Set ShpPie = Me.Shapes("~" & rngCell.Address)
ShpPie.Left = rngCell.Left + _
iHorizontal * (rngCell.Width - ShpPie.Width)
ShpPie.Top = rngCell.Top + _
iVertical * (rngCell.Height - ShpPie.Height)
End If
Next rngCell
Range(strActiveCellAddress).Select
'next line of code is the last part of the solution
'to the "average of values on other sheet" problem
Sheets(strActiveSheet).Activate
End Sub

Ken Johnson

Hi Daigles,

You're welcome.
Thanks for the feedback

Ken Johnson