• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Change in-cell tick/check-box value in multiple ranges using SelectionChange

Ahh... A slight problem...


Linked to this post and my earlier post (selecting a range via a hyperlink and then printing selection) - the problem I now face is that my original "Print" code and my "Edit" code listed now no longer function accordingly, my code so far is thus;-

[pre]
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Dim n1 As Integer
Dim n2 As Integer
Dim d As Integer

If Target.Count > 1 Then Exit Sub

n1 = Target.Row - 23
n2 = Target.Row - 25
d = 34

If (n1 - d * Int(n1 / d) <> 0 And n2 - d * Int(n2 / d) <> 0) Or Intersect(Target, Range("D:I")) Is Nothing Then Exit Sub
If Target = "ý" Then
Target = "=Hyperlink("""",""þ"")"
Target.Font.Name = "Wingdings"
Target.Font.Underline = False
Target.Font.Size = 22
ActiveCell.Offset(-1, 0).Select
Else
Target = "ý"
Target = "=Hyperlink("""",""ý"")"
Target.Font.Name = "Wingdings"
Target.Font.Underline = False
Target.Font.Size = 22
ActiveCell.Offset(-1, 0).Select
End If
[/pre]
 
I have a slight problem...


Linked to this post and my earlier post (selecting a range via a hyperlink and then printing selection) - the problem I now face is that my original "Print" code and my "Edit" code no longer function when accordingly, my code so far is thus;-
 
[pre]
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Dim n1 As Integer
Dim n2 As Integer
Dim d As Integer

If Target.Count > 1 Then Exit Sub

n1 = Target.Row - 23
n2 = Target.Row - 25
d = 34

If (n1 - d * Int(n1 / d) <> 0 And n2 - d * Int(n2 / d) <> 0) Or Intersect(Target, Range("D:I")) Is Nothing Then Exit Sub
If Target = "ý" Then
Target = "=Hyperlink("""",""þ"")"
Target.Font.Name = "Wingdings"
Target.Font.Underline = False
Target.Font.Size = 22
ActiveCell.Offset(-1, 0).Select
Else
Target = "ý"
Target = "=Hyperlink("""",""ý"")"
Target.Font.Name = "Wingdings"
Target.Font.Underline = False
Target.Font.Size = 22
ActiveCell.Offset(-1, 0).Select
End If

If Target.Value = "Print" Then
Dim iCurRw As Integer
iCurRw = Target.Row + 1
Range("C" & iCurRw & ":Q" & (iCurRw + 25)).Select

Dim xCopies As Integer
On Error Resume Next

Do Until xCopies > 0
xCopies = InputBox("How many copies do you want?", "Copies", 1)
If xCopies = "" Then Exit Sub
Loop
On Error GoTo 0
Selection.PrintOut Copies:=xCopies
End If

If Target.Value = "Q1 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q2 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q3 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q4 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q1 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q2 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q3 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q4 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Notes" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Baseline" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Prev. Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Target" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "National Comparator" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Statistical Neighbour" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Column > 1 Then Exit Sub
ActiveWindow.ScrollRow = ActiveCell.Row
End Sub
[/pre]
 
[pre]
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Dim n1 As Integer
Dim n2 As Integer
Dim d As Integer

If Target.Count > 1 Then Exit Sub

n1 = Target.Row - 23
n2 = Target.Row - 25
d = 34

If (n1 - d * Int(n1 / d) <> 0 And n2 - d * Int(n2 / d) <> 0) Or Intersect(Target, Range("D:I")) Is Nothing Then Exit Sub
If Target = "ý" Then
Target = "=Hyperlink("""",""þ"")"
Target.Font.Name = "Wingdings"
Target.Font.Underline = False
Target.Font.Size = 22
ActiveCell.Offset(-1, 0).Select
Else
Target = "ý"
Target = "=Hyperlink("""",""ý"")"
Target.Font.Name = "Wingdings"
Target.Font.Underline = False
Target.Font.Size = 22
ActiveCell.Offset(-1, 0).Select
End If

If Target.Value = "Print" Then
Dim iCurRw As Integer
iCurRw = Target.Row + 1
Range("C" & iCurRw & ":Q" & (iCurRw + 25)).Select

Dim xCopies As Integer
On Error Resume Next

Do Until xCopies > 0
xCopies = InputBox("How many copies do you want?", "Copies", 1)
If xCopies = "" Then Exit Sub
Loop
On Error GoTo 0
Selection.PrintOut Copies:=xCopies
End If

If Target.Value = "Q1 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q2 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q3 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q4 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q1 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q2 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q3 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q4 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Notes" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Baseline" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Prev. Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Target" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "National Comparator" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Statistical Neighbour" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Column > 1 Then Exit Sub
ActiveWindow.ScrollRow = ActiveCell.Row
End Sub
[/pre]
 
Sorry for the multiple posts, only this forum is refusing to allow me to post my code AAAARRRRGGGGGHHHH!!!!! Even though I've placed the code between
Code:
characters is just simply refuses - I've tried reducing the number of characters thinking there was some kind of character limit or something but even when I split the message into tiny chunks of code it is refusing!


I've posted code here before without a hitch! ?? Any advice please? Sorry for going off on a tangent with this post!


Cheers
 
Alex,


Looks like your post(s) was flagged as SPAM and was getting hidden. I've used my ninja powers (aka, admin) to un-spam one of the posts.


There is a bit of rambling in your previous posts...do you need/want me to delete any of the previous entries to clean this thread up?


On topic...

Your code has a large section of code, where it looks like no matter what the value, you do a select and sendkeys operation. Why all the repetition?
 
Hi Luke, sorry for the rambling above, only I was trying several times to post the code and it was refusing, hence the posts declining into rambling as I was trying to sort out the reason - but yes if you could clean up the post that would be kind of you!


My code should have looked like this;-

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Dim n1 As Integer
Dim n2 As Integer
Dim d As Integer

If Target.Count > 1 Then Exit Sub

n1 = Target.Row - 23
n2 = Target.Row - 25
d = 34

If (n1 - d * Int(n1 / d) <> 0 And n2 - d * Int(n2 / d) <> 0) Or Intersect(Target, Range("D:I")) Is Nothing Then Exit Sub
If Target = "ý" Then
Target = "=Hyperlink("""",""þ"")"
Target.Font.Name = "Wingdings"
Target.Font.Underline = False
Target.Font.Size = 22
ActiveCell.Offset(-1, 0).Select
Else
Target = "ý"
Target = "=Hyperlink("""",""ý"")"
Target.Font.Name = "Wingdings"
Target.Font.Underline = False
Target.Font.Size = 22
ActiveCell.Offset(-1, 0).Select
End If

If Target.Value = "Print" Then
Dim iCurRw As Integer
iCurRw = Target.Row + 1
Range("C" & iCurRw & ":Q" & (iCurRw + 25)).Select

Dim xCopies As Integer
On Error Resume Next

Do Until xCopies > 0
xCopies = InputBox("How many copies do you want?", "Copies", 1)
If xCopies = "" Then Exit Sub
Loop
On Error GoTo 0
Selection.PrintOut Copies:=xCopies
End If

If Target.Value = "Q1 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q2 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q3 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q4 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q1 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q2 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q3 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q4 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Notes" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Baseline" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Prev. Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Target" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "National Comparator" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Statistical Neighbour" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Column > 1 Then Exit Sub
ActiveWindow.ScrollRow = ActiveCell.Row
End Sub

I apologise for the code above, even though it looks like repetition, it actually functions on a few select cells that I have selected for the user to click (i.e. if cell value = "Target" and the user clicks the cell, it will take them to the cell directly below (using a hyperlink) and allow them to edit the target.). This code was working prior to the additional code you gave me above to replace my "If Not Intersect..." code, however, although your code works beautifully for selecting my checkboxes, it now appears that when my labelled cells (including the cell named "Target") are selected, my code for "editing" the selected cell no longer works and also, the "Print" code from my previous post which you helped on (remember that one?) also fails to function.


I have probably done something really stupid and obvious that an expert like yourself can solve in an instant, but I can't find my way around it.


Thanks Luke


Alex
 
Hi again Luke, I have just tried to post my code again, only for the same thing to happen, can you use your "Ninja Powers" to "un-spam" it for me please?


Sorry and thanks
 
Just to comment on the "ninja power" problem..


I have been having the exact same problem with virtually ALL of my recent posts. Maybe somethings changed (for the worst) with the forum admin settings?


I can get around it by posting a dummy post with like a "." in it or something, then immediately editing it and pasting in my full post.


Asa
 
Hi Luke, sorry for the rambling above, only I was trying several times to post the code and it was refusing, hence the posts declining into rambling as I was trying to sort out the reason - but yes if you could clean up the post that would be kind of you!


My code should have looked like this;-

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Dim n1 As Integer
Dim n2 As Integer
Dim d As Integer

If Target.Count > 1 Then Exit Sub

n1 = Target.Row - 23
n2 = Target.Row - 25
d = 34

If (n1 - d * Int(n1 / d) <> 0 And n2 - d * Int(n2 / d) <> 0) Or Intersect(Target, Range("D:I")) Is Nothing Then Exit Sub
If Target = "ý" Then
Target = "=Hyperlink("""",""þ"")"
Target.Font.Name = "Wingdings"
Target.Font.Underline = False
Target.Font.Size = 22
ActiveCell.Offset(-1, 0).Select
Else
Target = "ý"
Target = "=Hyperlink("""",""ý"")"
Target.Font.Name = "Wingdings"
Target.Font.Underline = False
Target.Font.Size = 22
ActiveCell.Offset(-1, 0).Select
End If

If Target.Value = "Print" Then
Dim iCurRw As Integer
iCurRw = Target.Row + 1
Range("C" & iCurRw & ":Q" & (iCurRw + 25)).Select

Dim xCopies As Integer
On Error Resume Next

Do Until xCopies > 0
xCopies = InputBox("How many copies do you want?", "Copies", 1)
If xCopies = "" Then Exit Sub
Loop
On Error GoTo 0
Selection.PrintOut Copies:=xCopies
End If

If Target.Value = "Q1 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q2 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q3 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q4 Analysis" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q1 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q2 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q3 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Q4 Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Notes" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Baseline" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Prev. Outturn" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Target" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "National Comparator" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Value = "Statistical Neighbour" Then
ActiveCell.Select
Application.SendKeys "{F2}"
End If

If Target.Column > 1 Then Exit Sub
ActiveWindow.ScrollRow = ActiveCell.Row
End Sub

I apologise for the code above, even though it looks like repetition, it actually functions on a few select cells that I have selected for the user to click (i.e. if cell value = "Target" and the user clicks the cell, it will take them to the cell directly below (using a hyperlink) and allow them to edit the target.). This code was working prior to the additional code you gave me above to replace my "If Not Intersect..." code, however, although your code works beautifully for selecting my checkboxes, it now appears that when my labelled cells (including the cell named "Target") are selected, my code for "editing" the selected cell no longer works and also, the "Print" code from my previous post which you helped on (remember that one?) also fails to function.


I have probably done something really stupid and obvious that an expert like yourself can solve in an instant, but I can't find my way around it.


Thanks Luke


Alex
 
Thanks asa for the tip on the post problem, your advice worked a treat. Yes I have been having problems posting recently too!
 
Luke, Mod operator..

Code:
x = 55-23 mod 32

is being interpreted as

[code]x = 55-(23 mod 32)


Add parens for expected result:

[code]x = (55-23) mod 32


~~~~~~~~~~~~~~


Alex,


:) Yeah, I was stumped for a bit trying to get my posts up yesterday before I figured it out...

[quote]
I have a slight problem...


Linked to this post and my earlier post (selecting a range via a hyperlink and then printing selection) - the problem I now face is that my original "Print" code and my "Edit" code no longer function
[/quote]

Well, the new code added has some [code]Exit Sub commands if certain criteria about the Target range are met.


That is most likely the reason your original print/edit code is not executing.


The solution is to change the logic, to direct the program flow to the right code depending on the cell or it's contents now selected (the Target)...


Your code now could be abbreviated as:

[pre][code]Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
(new code)
(old code)
End Sub
This alternative should work:

[pre][code]Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Select Case True
Case (new code criteria)
(new code)
Case (old code criteria)
(old code)
Case (some other code criteria) ' just an example of extending the logic with added tasks
(some other code)
Case Else ' optional
(code for cases where none of the above were met)
End Select
End Sub
Select Case in this form operates log [code]If...Then...ElseIf...ElseIf...ElseIf...Else...End If --- All cases are exclusive of each other and the first case's criteria that is met is the only case executed.


The Case statements can handle multiple criteria like these:

[pre]Case A=B, A=C, B=G
We started the Select Case statement as

Select Case True[/code][/pre]
"True" in that statement is any expression that is compared to every expression in one of the following Case[/code] lines. You could also use:


Select Case FavoriteFood[/code][/pre]
In which case, each Case[/code] line could have criteria to compare to FavoriteFood, rather than an expression that on it's own evaluates to True[/code] :)


like:

Select Case FavoriteFood
Case "lobster"
Case "pizza"
Case FavFoodOfAlex
Case "alphabet soup" To "dungeness crab" ' a range of items
Case "pickled plums", "apple pie", "cheese cake" ' a list of items
Case Is > "yams" ' unexpected foods at the end of the alphabet; any comparison operators can be used
End Select[/code][/pre]
~~~~~

Specifically in your case, I think this might do the trick:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim n1 As Integer
Dim n2 As Integer
Dim d As Integer

Dim xCopies As Variant
Dim iCurRw As Integer

n1 = Target.Row - 23
n2 = Target.Row - 25
d = 34

Select Case True
Case Not (Target.Count > 1 Or (n1 - d * Int(n1 / d) <> 0 And n2 - d * Int(n2 / d) <> 0) Or Intersect(Target, Range("D:I")) Is Nothing)
If Target = "ý" Then
Target = "=Hyperlink("""",""þ"")"
Target.Font.Name = "Wingdings"
Target.Font.Underline = False
Target.Font.Size = 22
ActiveCell.Offset(-1, 0).Select
Else
Target = "ý"
Target = "=Hyperlink("""",""ý"")"
Target.Font.Name = "Wingdings"
Target.Font.Underline = False
Target.Font.Size = 22
ActiveCell.Offset(-1, 0).Select
End If
Case Else
Select Case True
Case Target.Value = "Print"
iCurRw = Target.Row + 1
Range("C" & iCurRw & ":Q" & (iCurRw + 25)).Select

On Error Resume Next
Do
xCopies = Application.InputBox("How many copies do you want?", "Copies", 1, Type:=1) ' Application.InputBox has added features / Type:=1 restricts to returning a number, or False if cancelled
Loop While xCopies <> False Or xCopies < 1
On Error GoTo 0
If xCopies <> False Then Selection.PrintOut Copies:=xCopies
Case Target.Value Like "Q[1234] Analysis", _
Target.Value Like "Q[1234] Outturn", _
Target.Value = "Notes", _
Target.Value = "Baseline", _
Target.Value = "Prev. Outturn", _
Target.Value = "Target", _
Target.Value = "National Comparator", _
Target.Value = "Statistical Neighbour"
ActiveCell.Select
Application.SendKeys "{F2}"
End Select
If Target.Column = 1 Then ActiveWindow.ScrollRow = ActiveCell.Row
End Select

As you can see, I went ahead and reorganized your existing code as well, to make the program flow logic clear, to work in this Select..Case logic, and to reduce redundancy. I had to make a few assumptions, so adjust/ask if there are problems.


Also, you had a bug where you checked if
Code:
xCopies = "" ... xCopies was declared as an Integer, so it could only be a number, no matter what the function you set it with wanted to return, and it would never = "".


I declared xCopies as a Variant instead, and used some alternative logic.


Generally [code]Exit commands get you into trouble, and make tracking the flow of complex code more difficult.  They should be used as a last resort, when the cost of the alternatives that come to mind seems too high.


Another program flow issue was the multiple If statements that were actually exclusive of one another.  That muddies the logic of your code, and slows it down, since VBA checks to see if many conditions that you already know will never all be true, are all true.  Better to use If / ElseIf / Else
or Select Case[/code].


Happy Halloween my friend!

Asa
 
Luke, Mod operator..

Code:
x = 55-23 mod 32

is being interpreted as

[code]x = 55-(23 mod 32)


Add parens for expected result:

[code]x = (55-23) mod 32


~~~~~~~~~~~~~~


Alex,


:) Yeah, I was stumped for a bit trying to get my posts up yesterday before I figured it out...

[quote]
I have a slight problem...


Linked to this post and my earlier post (selecting a range via a hyperlink and then printing selection) - the problem I now face is that my original "Print" code and my "Edit" code no longer function

[/quote]

Well, the new code added has some [code]Exit Sub commands if certain criteria about the Target range are met.


That is most likely the reason your original print/edit code is not executing.


The solution is to change the logic, to direct the program flow to the right code depending on the cell or it's contents now selected (the Target)...


Your code now could be abbreviated as:

[pre][code]Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
(new code)
(old code)
End Sub
This alternative should work:

[pre][code]Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Select Case True
Case (new code criteria)
(new code)
Case (old code criteria)
(old code)
Case (some other code criteria) ' just an example of extending the logic with added tasks
(some other code)
Case Else ' optional
(code for cases where none of the above were met)
End Select
End Sub
Select Case in this form operates like [code]If...Then...ElseIf...ElseIf...Else... --- All cases are exclusive of each other and the first case's criteria that is met is the only case executed.


The Case statements can handle multiple criteria like these:

[pre]Case A=B, A=C, B=G
We started the Select Case statement as

Select Case True[/code][/pre]
"True" in that statement is any expression that is compared to every expression in one of the following Case[/code] lines. You could also use:


Select Case FavoriteFood[/code][/pre]
In which case, each Case[/code] line could have criteria to compare to FavoriteFood, rather than an expression that on it's own evaluates to True[/code] :)


like:

Select Case FavoriteFood
Case "lobster"
Case "pizza"
Case FavFoodOfAlex
Case "alphabet soup" To "dungeness crab" ' a range of items
Case "pickled plums", "apple pie", "cheese cake" ' a list of items
Case Is > "yams" ' unexpected foods at the end of the alphabet; any comparison operators can be used
End Select[/code][/pre]
~~~~~

Specifically in your case, I think this might do the trick:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim n1 As Integer
Dim n2 As Integer
Dim d As Integer

Dim xCopies As Variant
Dim iCurRw As Integer

n1 = Target.Row - 23
n2 = Target.Row - 25
d = 34

Select Case True
Case Not (Target.Count > 1 Or (n1 - d * Int(n1 / d) <> 0 And n2 - d * Int(n2 / d) <> 0) Or Intersect(Target, Range("D:I")) Is Nothing)
If Target = "ý" Then
Target = "=Hyperlink("""",""þ"")"br />Target.Font.Name = "Wingdings"
Target.Font.Underline = False
Target.Font.Size = 22
ActiveCell.Offset(-1, 0).Select
Else
Target = "ý"
Target = "=Hyperlink("""",""ý"")"
Target.Font.Name = "Wingdings"
Target.Font.Underline = False
Target.Font.Size = 22
ActiveCell.Offset(-1, 0).Select
End If
Case Else
Select Case True
Case Target.Value = "Print"
iCurRw = Target.Row + 1
Range("C" & iCurRw & ":Q" & (iCurRw + 25)).Select

On Error Resume Next
Do
xCopies = Application.InputBox("How many copies do you want?", "Copies", 1, Type:=1) ' Application.InputBox has added features / Type:=1 restricts to returning a number, or False if cancelled
Loop While xCopies <> False Or xCopies < 1
On Error GoTo 0
If xCopies <> False Then Selection.PrintOut Copies:=xCopies
Case Target.Value Like "Q[1234] Analysis", _
Target.Value Like "Q[1234] Outturn", _
Target.Value = "Notes", _
Target.Value = "Baseline", _
Target.Value = "Prev. Outturn", _
Target.Value = "Target", _
Target.Value = "National Comparator", _
Target.Value = "Statistical Neighbour"
ActiveCell.Select
Application.SendKeys "{F2}"
End Select
If Target.Column = 1 Then ActiveWindow.ScrollRow = ActiveCell.Row
End Select

As you can see, I went ahead and reorganized your existing code as well, to make the program flow logic clear, to work in this Select..Case logic, and to reduce redundancy. I had to make a few assumptions, so adjust/ask if there are problems.


Also, you had a bug where you checked if
Code:
xCopies = "" ... xCopies was declared as an Integer, so it could only be a number, no matter what the function you set it with wanted to return, and it would never = "".


I declared xCopies as a Variant instead, and used some alternative logic.


Generally [code]Exit commands get you into trouble, and make tracking the flow of complex code more difficult.  They should be used as a last resort, when the cost of the alternatives that come to mind seems too high.


Another program flow issue was the multiple If statements that were actually exclusive of one another.  That muddies the logic of your code, and slows it down, since VBA checks to see if many conditions that you already know will never all be true, are all true.  Better to use If / ElseIf / Else
or Select Case[/code].


Happy Halloween my friend!

Asa
 
I made an error.


Where it reads:

[pre]
Code:
Do
xCopies = Application.InputBox("How many copies do you want?", "Copies", 1, Type:=1) ' Application.InputBox has added features / Type:=1 restricts to returning a number, or False if cancelled
Loop While xCopies <> False Or xCopies < 1
That will loop forever, since if they type a number, xCopies <> False, and if they Cancel, VBA is willing to call False < 1.


This poses a little problem for a our looping logic, since type coersion is converting the boolean result to an integer of some sort, making False = 0 (True in VBA would be = -1).


However, if the users enters "0" we intend to loop.  If they cancel, we intend not to loop.


A simple solution is to check what the type of the xCopies variable is.  Is it a Boolean?  If so, we don't even need to check -- we know that the value is False.  Otherwise, we can check the number of copies.

[pre][code]Do
xCopies = Application.InputBox("How many copies do you want?", "Copies", 1, Type:=1) ' Application.InputBox has added features / Type:=1 restricts to returning a number, or False if cancelled
Loop While VarType(xCopies) <> vbBoolean And xCopies < 1
~~~~~~~


Another problem that I think was pre-existing is that you will get a type mismatch error if the user selects a range of cells and your VBA code tests Target.Value.  A Range, of course, has many values.


To correct that, replace these two Case lines:

[pre][code]Case Target.Value = "Print"

Case Target.Value Like "Q[1234] Analysis", _
Target.Value Like "Q[1234] Outturn", _
Target.Value = "Notes", _
Target.Value = "Baseline", _
Target.Value = "Prev. Outturn", _
Target.Value = "Target", _
Target.Value = "National Comparator", _
Target.Value = "Statistical Neighbour"[/pre]
With these, which specify to check just the first cell selected, and also check that only one cell is selected:


Case Target.Count = 1 And Target(1, 1).Value = "Print"

Case Target.Count = 1 And Target(1, 1).Value Like "Q[1234] Analysis", _
Target.Count = 1 And Target(1, 1).Value Like "Q[1234] Outturn", _
Target.Count = 1 And Target(1, 1).Value = "Notes", _
Target.Count = 1 And Target(1, 1).Value = "Baseline", _
Target.Count = 1 And Target(1, 1).Value = "Prev. Outturn", _
Target.Count = 1 And Target(1, 1).Value = "Target", _
Target.Count = 1 And Target(1, 1).Value = "National Comparator", _
Target.Count = 1 And Target(1, 1).Value = "Statistical Neighbour"
[/pre]
Actually; your preference, but in the case of the second Case[/code], we've now introduced redundancy that could be eliminated if written like this instead:


Case Target.Count = 1 And ( _
Target(1, 1).Value Like "Q[1234] Analysis" Or _
Target(1, 1).Value Like "Q[1234] Outturn" Or _
Target(1, 1).Value = "Notes" Or _
Target(1, 1).Value = "Baseline" Or _
Target(1, 1).Value = "Prev. Outturn" Or _
Target(1, 1).Value = "Target" Or _
Target(1, 1).Value = "National Comparator" Or _
Target(1, 1).Value = "Statistical Neighbour" _
)[/code][/pre]
Asa
 
WOOHOO! That worked! Asa, Luke and Prasad and everyone else who has helped on my other post, you are all truly "Awesome in Excel". I owe you all a debt of gratitude!


As I stated earlier, I have a little knowledge of VBA (a little knowledge is dangerous, I know) and although sometimes I know what I want to achieve and know (very roughly) how to achieve it, stating the correct syntax and making efficient code is beyond me at the moment.


Once I have understood and taken in all your comments, I am sure I will get there but it will take some time.


Thank you all very much for your time, no doubt finding a solution to this problem will just take me a little step towards finding another problem with my spreadsheet but hey, that's another story...


Cheers, Alex
 
Luke, Mod operator..

x = 55-23 mod 32

is being interpreted as

x = 55-(23 mod 32)

DOH! Thanks Asa, sometimes it's the simple things that get me...


Big kudos to Asa for code re-write and explanation. Asa's also solves another issue, which might not have been apparent. Alexsheehan's first code had several .Select commands in it. However, as this is a Selection_Change event macro, this was causing the macro to refire! Yikes! If you're not careful, you'll end up in a big loop.

One possible way to get around that is to use the

Application.EnableEvents = False

near the beginning of your code. The only trick is, this setting doesn't get "reset" when your code ends, so you need to make sure it alwasy gets set back to true before ending/exiting the macro.

Application.EnableEvents = True
 
Back
Top