Same Variable With Different Meanings In Same Macro (for lack of better title?)

[Ark68]

Hi folks,

I'm at a point in my VBA application where a hurdle is preventing me from moving forward.

I have a worksheet that provides an interface for the user to click on radio "style" shapes to select which report or combination of multiple reports to print. The radio buttons provided in the form controls are too tiny and don't provide the flexibility I am looking for, so I've substituted them with macro enabled shapes.

There are 6 individual reports (CUEDR, CUEDT, CUEFR, CUEFT, CUECR and CUECT). When the user clicks the shape (rtarget), the macro is called which calls a routine. The routine checks the appropriateness of the report request (record has to have at least 1 record to be considered appropriate), shades it, and puts the report name in the print cue.

There is also a 7th clickable shape option. CUEALL (rtarget), when clicked allows the user to choose all 6 records together. The way I have it working now (and I know it's not glamorous or efficient) , if the CUEALL procedure calls each one of the reports individual procedures to execute.

Herein lay the problem. When CUEALL is selected, rtarget = CUEALL. Since the individual reports rely on rtarget= to their respective shapes for shading, the code is incomplete. The intended result is for all individual shapes be shaded (when appropriate) and the CUEALL shape. But with this code ... when all is said and done, only the CUEALL shape gets shaded, and only CUEALL is placed in the cue (when it should be one or more of either CUEDR, CUEDT, CUEFR, CUEFT, CUECR and CUECT)

What do I need to do to get the individual shapes to shade and the individual report names put in the cue when a group shape is selected?

Sub toggle()
    Dim wshwo As Worksheet
    Dim wshvar As Worksheet
    Dim rtarget As Variant
    Dim nextrow As Integer
    Dim p1 As Variant

    Set wshvar = Worksheets("varhold")
    Set wshwo = Worksheets("Workorders")
    Set rtarget = wshwo.Shapes(Application.Caller)
    
    nextrow = wshvar.Cells(Rows.Count, "T").End(xlUp).Row + 1

    With wshwo
        If rtarget.Name = "CUEDR" Then
            Call rtCUEDR
        ElseIf rtarget.Name = "CUEDT" Then
            Call rtCUEDT
        ElseIf rtarget.Name = "CUEFR" Then
            Call rtCUEFR
        ElseIf rtarget.Name = "CUEFT" Then
            Call rtCUEFT
        ElseIf rtarget.Name = "CUECR" Then
            Call rtCUECR
        ElseIf rtarget.Name = "CUEFT" Then
            Call rtCUECT
        Else 'rtarget.name="CUEALL"
            Call rtCUEDR
            Call rtCUEDT
            Call rtCUEFR
            Call rtCUEFT
            Call rtCUECR
            Call rtCUECT
        End If
    End With
End Sub

Sub shade_me()

    Dim wshwo As Worksheet
    Dim wshvar As Worksheet
    Dim rtarget As Variant
    Dim nextrow As Integer
    Dim p1 As Variant

    Set wshvar = Worksheets("varhold")
    Set wshwo = Worksheets("Workorders")
    Set rtarget = wshwo.Shapes(Application.Caller)
        
    nextrow = wshvar.Cells(Rows.Count, "T").End(xlUp).Row + 1
    If rtarget.Fill.ForeColor.RGB = RGB(255, 255, 255) Then 'OFF to ON
        rtarget.Fill.ForeColor.RGB = RGB(255, 0, 0)
        wshvar.Range("T" & nextrow) = rtarget.Name
    Else
        rtarget.Fill.ForeColor.RGB = RGB(255, 255, 255) 'ON to OFF
        p1 = wshvar.Range("T3:T500").Find(What:=rtarget.Name).Address
        wshvar.Cells.Range(p1).Delete xlUp
    End If

End Sub

Sub rtCUEDR()
    If ActiveSheet.Range("E10").Value = 0 Then
        MsgBox "Skip CUEDR"
        Exit Sub
    Else
        Call shade_me
    End If
End Sub

Sub rtCUEDT()
    If ActiveSheet.Range("F10").Value = 0 Then
        MsgBox "Skip CUEDT"
        Exit Sub
    Else
        Call shade_me
    End If
End Sub

Sub rtCUEFR()
    If ActiveSheet.Range("G10").Value = 0 Then
        MsgBox "Skip CUEFR"
        Exit Sub
    Else
        Call shade_me
    End If
End Sub
Sub rtCUEFT()
    If ActiveSheet.Range("H10").Value = 0 Then
        MsgBox "Skip CUEFT"
        Exit Sub
    Else
        Call shade_me
    End If
End Sub
Sub rtCUECR()
    If ActiveSheet.Range("I10").Value = 0 Then
        MsgBox "Skip CUECR"
        Exit Sub
    Else
        Call shade_me
    End If
End Sub
Sub rtCUECT()
    If ActiveSheet.Range("J10").Value = 0 Then
        MsgBox "Skip CUECT"
        Exit Sub
    Else
        Call shade_me
    End If
End Sub

 

[Jerry Sullivan]

Ah...that's the one part I didn't mock up. Sorry.

For your current approach the Case Else would need to assign the Shape for the 6 Calls....

Else 'rtarget.name="CUEALL"
     Call rtCUEDR(wshwo.Shapes("CUEDR"))
     Call rtCUEDT(wshwo.Shapes("CUEDT"))
     '....

If you were going to keep the 6 separate subs, this passing of the shape is unnecessary because you could just hard-code the name of each shape into its corresponding sub.

However, if you follow through and rework the code to eliminate the 6 subs, you'll probably do something like this using an array of shape names.

For i = 1 To 6
    Call shade_me(wshwo.Shapes(vShapeNames(i)))
Next i

Just ask if you want some help with that rework after you get your current approach functioning.

 

[Ark68]

Done for the day now Jerry ... some R&R for us both. They is a good chance I'll be crying on your doorstep when / if we move forward to rework.
I'll be back with a report on progress. Again ... thanks for your help and patience.

 

[Ark68]

Good day Jerry ...

I applied your suggestions to the 'Toggle' code as suggested. I simply changed :

        Else 'rtarget.name="CUEALL"
            Call rtCUEDR(.Shapes("CUEDR"))
            Call rtCUEDT(.Shapes("CUEDT"))
            Call rtCUEFR(.Shapes("CUEFR"))
            Call rtCUEFT(.Shapes("CUEFT"))
            Call rtCUECR(.Shapes("CUECR"))
            Call rtCUECT(.Shapes("CUECT"))

Sadly, it's resulting in the same results as in post #10. Perhaps I missed something as your reference to 'Case Else' threw me off ... is this something I omitted at some point?

 

[Jerry Sullivan]

Hmm....that should have worked.

If you're needing to get this resolved urgently, I'd be glad to take a look at your file. Please send me a PM and we can exchange email addresses.

If it isn't urgent, I'd suggest you step though the code one line at a time using F8 in the VBE. Check to see that the code is executing the expected lines, and watch the expression rTarget.Name to see if that changes as expected.

 

[Ark68]

Hi Jerry,

I stepped through the code, and it appears there are issues with the 'shade_me' sub. It appears that rTarget is only ever being recognized as CUEALL, despite the rtCUE* sub it was launched by. When rtCUEDR hits the 'shade_me' sub, it shades CUEALL, and places CUEALL in the print cue. Then, when rtCUEDT call 'shade_me', it recognizes rTarget as being CUEALL. Since CUEALL was previously shaded, it is now unshaded. This cycle repeats throughthe remaining 4 rtCUE* subs.

You can download the file here Jerry.
https://docs.google.com/file/d/0B9EE-tbOy4bJRVJ5aEMwdjFPd3c/edit?usp=sharing

Modiule 25 holds the revelvant code.

 

[Jerry Sullivan]

Jenn, The file at that link doesn't appear to have all the relevant VBA code. There's no standard modules only the ThisWorkbook and Sheet modules.

It looks like you might not have transfered the info from the linked workbook SportB.xlsm to the example SportBz.xlsm.

 

[Ark68]

Try this ....
https://docs.google.com/file/d/0B9EE-tbOy4bJckprX3JndmEtUkk/edit?usp=sharing

I've been getting an odd link from these worksheets to "book5" I have no idea where it is coming from. I've used a FINDLINK tool which came up negative. I searched all the code for that reference and found nothing. I deleted all the shapes in worksheet "Workorders" and still nothing. If you find it ... let me know.



Jenn

 

[Jerry Sullivan]

Jenn,

You need to delete the statement shown in red - it's resetting rTarget.

Sub shade_me(rTarget As Shape)

    Dim wshwo As Worksheet
    Dim wshvar As Worksheet
    Dim nextrow As Integer
    Dim p1 As Variant

    Set wshvar = Worksheets("varhold")
    Set wshwo = Worksheets("Workorders")
 [COLOR="#FF0000"]'   Set rTarget = wshwo.Shapes(Application.Caller)[/COLOR]

I made that modification in Post #9, but didn't call it to your attention.

 

[Ark68]

That was easy enough! What can we do to shade CUEALL ... or is only one or the other possible?

 

[Jerry Sullivan]

You could add that code at the end of your Else statements.

       Else 'rtarget.name="CUEALL"
            Call rtCUEDR(.Shapes("CUEDR"))
            Call rtCUEDT(.Shapes("CUEDT"))
            Call rtCUEFR(.Shapes("CUEFR"))
            Call rtCUEFT(.Shapes("CUEFT"))
            Call rtCUECR(.Shapes("CUECR"))
            Call rtCUECT(.Shapes("CUECT"))
            '--add code to Toggle Shading of CUEALL