VBA To Format Autoshape Based on Conditions 1

[shelby55]

Hello

I am using Excel 2003.

I have a dashboard type report that has graphs. I want to be able to program a face (happy, frown, indifferent) based on the results of another cell.

How can I do this via VBA? I was thinking that I'll need all 3 faces on the page but the applicable one is only visible (with the right colour) based on the results of the specific cell compared to its target.

How do I go about doing this - thanks.

Shelby

 

[SkipVought]

Hi,

Assign the Visible property of the shape as True or False.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi Skip

Okay but how do I do that using the contents of another field?

For instance, if worksheetA, cell F4 <57 then red sad face, else if cell F4 between 57 and 61 then yellow neutral face else if F4 >=62 then green happy face.

Thanks.

 

[SkipVought]

if worksheetA, cell F4 <57 then red sad face, else if cell F4 between 57 and 61 then yellow neutral face else if F4 >=62 then green happy face.

If worksheetA.cells(4, "F").value <57 then
   with SheetWithFaces
      .Shapes("red sad face").visible=true
      .Shapes("yellow neutral face").visible=false
      .Shapes("green yappy face").visible=false
   end with
 
else

end if

Skip,
[sub]
[glasses]Just traded in my old subtlety...
[b]for a NUANCE![/b][tongue][/sub]

 

[shelby55]

Hi Skip

Thanks. And if I wanted to program the assignent of the face depending on the cell what Event would I program it under? I'd like to do "on open" because when I was testing and tried "on sheet activate" it added one every time I activated the sheet and I only want this to happen once.

Thanks.

 

[SkipVought]

it added one every time I activated the sheet

Added WHAT?

Please post your code that does not work the way you want.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

HI

I was just testing to add a face without anything else but I can't figure out how to reference the sheet I want to add it to.

The code below adds a red frown face to all sheets.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

Sh.Shapes.AddShape(msoShapeSmileyFace, 367.5, 84.75, 78#, 75.75). _
        Select
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
    Selection.ShapeRange.Fill.Transparency = 0#
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.Adjustments.Item(1) = 0.7181

End Sub

So how do I reference the separate sheets i.e. the sheet where the formula for comparison is on versus the sheet I want the face on? Thanks.

 

[SkipVought]

Whay would you want to ADD, Every Single Time a sheet is activated?

What is your REQUIREMENT?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi

The whole workbook updates automatically on open with data from an Access query. The face (happy, frown, neutral) needs to apply to the most recent point on the chart.

This "point" is referenced in another worksheet as described above.

As per my question, I don't know what event to use the code on so it's not necessary to add every time the sheet is activated, just upon open I guess.

Having said that, the user can select from the summary page a date that will change the data in the reference cell and chart. But the reference cell is still the same.

Thanks.

 

[SkipVought]

just upon open I guess.

It's not a guessing game. YOUR requirement as to EXACTLY when YOU want something to happen.

So your MS Access query refreshes each time the workbook opens. Are you plotting the data on a chart? The smiley face identifies the last value on the chart? Why not just MOVE the previous smiley, or do you have a trail of them on your chart?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi

Yes I'm plotting data on a chart but based. The smiley face is supposed to identify the last value on the chart in terms of comparison to another cell value.

There isn't a "previous" smiley to move nor is there a trail. This is only to identify the last entry on the chart.

 

[SkipVought]

There isn't a "previous" smiley to move nor is there a trail. This is only to identify the last entry on the chart.

So just move it after the data has been refreshed.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi

But Skip I still don't know what syntax to use to add this to wherever I'm adding it to.

As queried before, how do I reference the sheet the formula is on versus the sheet (chart) where the smiley face is to go?

When you say move it to after the data is refreshed, is there an event for that?

Skip, I know you want people to help themselves and not just give them answers but as I mentioned, I'm new to VBA and not understanding everything as you do. Your assistance to piece this together is greatly appreciated.

 

[SkipVought]

What event is refreshing the query?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi

The workbook queries the database on open and then saves a copy elsewhere. The following is called on Open:

Sub copyWorkbook()
Dim ws As Worksheet
Dim NewWB As Workbook
Dim qt As QueryTable

'this keeps the copy from being displayed
    Application.ScreenUpdating = False
    Sheets(Array("WkA","WkB","WkC","WkD","WkE","WkF")).Copy
    Set NewWB = ActiveWorkbook
    Application.DisplayAlerts = False
    Application.CutCopyMode = False
    With NewWB.Sheets("WkA")
'unlock ALL cells
       With .Cells
          .Locked = False
          .FormulaHidden = False
       End With
'lock these cells
       With .Range("F4:M40")
           .Locked = True
           .FormulaHidden = False
       End With
       .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
  End With
'severs connection in wkD to the Access db
  With NewWB.Sheets("WkD")
    For Each qt In .QueryTables
      qt.Delete
    Next
'hides raw data worksheet
  NewWB.Sheets("WkD").Visible = xlSheetVeryHidden
  End With
  
'ensures the update links dialog box doesn't show up on open
    NewWB.UpdateLinks = xlUpdateLinksNever
    NewWB.SaveCopyAs Filename:="E:\My Documents\MyFileName_" & Format(Now(), "YYYYMMDD") & ".xls"
    ActiveWindow.Close
    Application.ScreenUpdating = True
End Sub

So all of the above works well but I've been asked to now include some charts in the workbook and they are based on named ranges. One of the worksheets is the "raw data" which has many formulae based on what is updated upon open from the Access database. Another worksheet has formulae/named ranges to capture (Vlookup) values for the last 20 weeks of data. On the summary page is a data validation named range for the date chosen by the user so these "last 20 weeks" will change depending on that value.

I want to have a face (smiley, frown, neutral) based on the last data period for each of the charts I produce. I would like to know how to reference named ranges in the syntax, how to reference the various worksheets (the one with the formulae versus the chart where the face is to go).

Thanks very much.

 

[SkipVought]

I do not see anywhere in the code you posted previously, where you are refreshing any querytable.

Rather, you are DELETING qt's in sheet WkD.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi Skip

The query was using MS-Query so the refresh is automatic upon opening.

Thanks.

 

[SkipVought]

I prefer to turn that feature off and refresh when I choose. But if you keep it that way, then you can move the shape anytime.

Here's a procedure that I have used in the past to position several shapes on a chart.

wsRpyChartData is the Sheet object where my chart source data resides.
I am using various aggregations from my chart source data to approximate the location on the chart where I want my shape. I have an Arrow (line) and a box (rectangle).

Public Sub PositionShapes()
    Dim shp As Shape, nTot As Integer, nWK As Integer, nWid As Integer
    With wsRpyChartData
        nTot = Application.CountA(.Range("A4:A108"))
        nWK = Application.CountA(.Range("L4:L108"))
    End With
    With Chart1
        nWid = .PlotArea.InsideWidth
        .Shapes("linNotation").Left = nWid * (nWK / nTot) + 20
        .Shapes("recNotation").Left = .Shapes("linNotation").Left
        nWK = wsParms.[DelinqLoanCnt]
        nWid = .PlotArea.InsideHeight
        .Shapes("linNotation").Top = nWid * ((nTot - nWK) / nTot) - .Shapes("linNotation").Height + .PlotArea.Top
        .Shapes("recNotation").Top = nWid * ((nTot - nWK) / nTot) - .Shapes("recNotation").Height * 2 + .PlotArea.Top
    End With
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi Skip

Thanks...but I'm still not understanding what the code you've provided me does.

I guess this is too complicated...thanks anyway.

 

[SkipVought]

It positions 2 shapes on a chart (Top & Left properties), based on aggregations of the chart source data.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}