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

A

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,562
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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?

Code: 
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

Code: 
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

Code: 
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
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Sort by date Sort by votes
Hi Ark68,

You could add pass an argument to the shade_me Sub instead of using Application.Caller inside that procedure.
Code: 
Sub shade_me(rTarget as Range)

Working with your current approach, you would also need to pass that argument to each of the rtCUE* subs.
Code: 
Sub rtCUEDR(rTarget as Range)

That would work, but I'd suggest you rework the code to do the testing for appropriateness of the report request inside Sub toggle and eliminate the six rtCUE* subs.
 
Upvote 0
Thank you so much for your reply Jerry, I was really beginning to believe that there was no hope overcoming this hurdle.

I have made the changes as you had suggested, and just wanted to get things working before I tackled the reworking to eliminate the six rtCUE subs.

I am however getting an error now in the 'toggle' sub. I receive a "Compile Error: Argument not optional" after I click on a shape to activate it. The code stops on the red highlighted line below ...

Rich (BB code): 
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
 
Upvote 0
Ark68 said:
Rich (BB code): 
    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"
Click to expand...

You might want to check the bits in red.
 
Upvote 0
You didn't post your revised rtCUE* subs, but if you used the declaration that I suggested, then each Call would need to pass rTarget as an argument.

For example:
Code: 
Call rtCUEDR(rTarget)
 
Upvote 0
Hi Jerry,

Made these changes ...
Code: 
With wshwo
        If rTarget.Name = "CUEDR" Then
            Call rtCUEDR(rTarget)
        ElseIf rTarget.Name = "CUEDT" Then
            Call rtCUEDT(rTarget)
        ElseIf rTarget.Name = "CUEFR" Then
            Call rtCUEFR(rTarget)
        ElseIf rTarget.Name = "CUEFT" Then
            Call rtCUEFT(rTarget)
        ElseIf rTarget.Name = "CUECR" Then
            Call rtCUECR(rTarget)
        ElseIf rTarget.Name = "CUECT" Then
            Call rtCUECT(rTarget)
        Else 'rtarget.name="CUEALL"
            Call rtCUEDR(rTarget)
            Call rtCUEDT(rTarget)
            Call rtCUEFR(rTarget)
            Call rtCUEFT(rTarget)
            Call rtCUECR(rTarget)
            Call rtCUECT(rTarget)
        End If
    End With
... based on what I think you were referring. Now receiving "Compile Error: ByRef argument type mismatch"

Here are the rtCUE* subs with changes suggested in your 1st post:
Code: 
Sub rtCUEDR(rTarget As Range)
    If ActiveSheet.Range("E10").Value = 0 Then
        MsgBox "Skip CUEDR"
        Exit Sub
    Else
        Call shade_me
    End If
End Sub

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

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

Thanks,
Jenn

And Ruddles ... good catch!! That would have been my next crisis! LOL
 
Upvote 0
Oops I didn't look at that carefully. I assumed rTarget was a Range as that's the variable naming convention I typically use.

You have rTarget declared as a Variant and Application.Caller passes it a Shape Object.
You'll need to change the Sub declarations like this .....

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


Sub shade_me(rTarget As Shape)
'.....
 
Last edited:
Upvote 0
Hi again Jerry,
With your suggested changes , I'm still unfortunately receiving a "Compile Error: ByRef argument type mismatch" in the 'Toggle' sub

Rich (BB code): 
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(rTarget)
        ElseIf rTarget.Name = "CUEDT" Then
            Call rtCUEDT(rTarget)
        ElseIf rTarget.Name = "CUEFR" Then
            Call rtCUEFR(rTarget)
        ElseIf rTarget.Name = "CUEFT" Then
            Call rtCUEFT(rTarget)
        ElseIf rTarget.Name = "CUECR" Then
            Call rtCUECR(rTarget)
        ElseIf rTarget.Name = "CUECT" Then
            Call rtCUECT(rTarget)
        Else 'rtarget.name="CUEALL"
            Call rtCUEDR(rTarget)
            Call rtCUEDT(rTarget)
            Call rtCUEFR(rTarget)
            Call rtCUEFT(rTarget)
            Call rtCUECR(rTarget)
            Call rtCUECT(rTarget)
        End If
    End With
End Sub

I changed the "Call shade_me" references to "Call shade_me(rTarget)" in rtCUE* subs.
 
Upvote 0
rTarget also needs to be declared as a Shape instead of a Variant.

This worked on my mockup using just one shape. You can adjust for your 7 shapes.

Code: 
Sub toggle()
    Dim wshwo As Worksheet
    Dim wshvar As Worksheet
    Dim rTarget As Shape
    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(rTarget)

        End If
    End With
End Sub

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

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")
   
        
    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
 
Upvote 0
Hey Jerry ... I think you're getting there.

No errors now, but some functionality is lost.

When the user selects Total (rTarget=CUEALL), it executes the six suvbs as instructed in the 'toggle' code.
The six rtCUE* subs execute, and properly assess the appropriateness ... skipping those in which their associated values = 0.
What isn't happening though, is the appropriate shapes aren't shaded when they pass, nor is the CUEALL shape shading, and most importantly, the passed report names aren't being sent over to the print cue.

As singular selections, everything works fine.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Code to Paste an Array
Replies
6
Views
301
Ark68
A
A
  • Question
SHape Ranges Not Performing 100%
Replies
0
Views
299
Ark68
A

Forum statistics

Threads
1,214,375
Messages
6,119,164
Members
448,870
Latest member
max_pedreira

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top