"far out request" magnifying in excel

[elmar007]

This is probably a very far out there request but here goes.......

Is there a formula which will magnify (preferably in a pop up box) a particular column heading when I am on a particular cell within that column

as 1 step further I wish to have the functionality to turn it on and off as a button

a colleague said they have seen it somewhere but cant remember where!

This tool would be particularly useful as I often need to look at spreadsheets which have to be 50% zoom. I know I can zoom but thats what I am trying to avoid!

cheers

RM

 

[Peter_SSs]

OK, try this in the sheet's module instead.

<font face=Courier New><br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_SelectionChange(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>  <SPAN style="color:#00007F">Dim</SPAN> r <SPAN style="color:#00007F">As</SPAN> Range<br>  <br>  <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> Intersect(ActiveCell, Columns("C:SU")) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>    Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> r = Intersect(ActiveCell, Cells.SpecialCells(xlCellTypeAllValidation))<br>    Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> r <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>      <SPAN style="color:#00007F">With</SPAN> ActiveCell.Validation<br>        .InputTitle = "Column Heading"<br>        .InputMessage = Cells(1, ActiveCell.Column).Value<br>      <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>  <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[elmar007]

Hi Peter

do you have a worked copy of it as i cant get code to run

it seems to have a issue with 'Set r = Intersect(ActiveCell, Cells.SpecialCells(xlCellTypeAllValidation))'

any ideas?

cheers

 

[Peter_SSs]

Hi Peter

do you have a worked copy of it as i cant get code to run

it seems to have a issue with 'Set r = Intersect(ActiveCell, Cells.SpecialCells(xlCellTypeAllValidation))'

any ideas?

cheers

Yes I do have a working copy but this being a public forum we like to keep as much as possible in the public arena and it is not possible to attach workbooks here.

Never-the-less hopefully we can get you going.

The only way I have been able to produce a problem with that line of code (you didn't detail exactly what any error message was) is if the worksheet has no Data Validation cells but in post #15 you indicated there was Data Validation in the cells in question where you wanted the magnification

The only thing that they can input into the cell is a Y or it is left blank (this is done through a dropdown including Y only)

 

[elmar007]

Hi Peter

Thankyou for helping me to puzzle through this

The first code you gave worked in providing the popups but with this one it gives a

'Runtime error 1004
No cells were found'

I have checked and there is data in the cells

i still like your idea of a popup if i can get it to be dynamic

cheers

 

[elmar007]

hi Laura

I cant see your images are they screenshots?

 

[Peter_SSs]

I have checked and there is data in the cells

Not Data, but Data Validation. When you select one of the cells in columns C:SU does it have a drop-down arrow on the right where you can choose a "Y"? That is what post #15 seemed to me to be indicating.

Can the users enter anything they like in cells in columns C:SU?

hi Laura

I cant see your images are they screenshots?

That was a spam post, which I have removed.

 

[elmar007]

Hi Peter
thankyou for perservering with me

The formula is sxcellent in working by itself but I think I have a conflict with another of my codes

Yes the data is entered via data validation
I have changed your formula to reflect column headings in row 7

The other code I have is a button to turn crosshatching on and off
A code to limit the viewable area
and lastly a code to limit user entries to a defined area

I have pasted the code below I am using with your one at the bottom

Private Sub Worksheet_Activate()
Me.ScrollArea = "T8:CU53"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Application.Intersect(Target, Range("T9:CR43")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
' Clear the color of all the cells
Cells.Interior.ColorIndex = 0
With Target
' Highlight the entire row and column that contain the active cell
.EntireRow.Interior.ColorIndex = 15
.EntireColumn.Interior.ColorIndex = 8
End With
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton1_Click()
With CommandButton1
If .BackColor <> &HFF00& Then
.BackColor = &HFF00&
Else
.BackColor = &HFF&
End If
End With
With Application
If .EnableEvents Then
.EnableEvents = False
Cells.Interior.ColorIndex = 0
CommandButton1.BackColor = &HFF00&
Exit Sub
End If
.EnableEvents = True
CommandButton1.BackColor = &HFF&
If Selection.Cells.Count > 1 Then Exit Sub
If Application.Intersect(Selection, Range("T9:CR43")) Is Nothing Then Exit Sub
With Selection
.EntireRow.Interior.ColorIndex = 15
.EntireColumn.Interior.ColorIndex = 8
End With
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range

If Not Intersect(ActiveCell, Columns("T9:CR43")) Is Nothing Then
Application.EnableEvents = False
Set r = Intersect(ActiveCell, Cells.SpecialCells(xlCellTypeAllValidation))
Application.EnableEvents = True
If Not r Is Nothing Then
With ActiveCell.Validation
.InputTitle = "Column Heading"
.InputMessage = Cells(7, ActiveCell.Column).Value
End With
End If
End If
End Sub

many thanks again

cheers
RM

 

[Peter_SSs]

When posting code please at least use Code Tags. My signature block explains how.
Reading & de-bugging unindented code is much more difficult.

Yes, you shouldn't have two separate Worksheet_SelectionChange event codes in the one worksheet module. You need to combine them.
Try removing those two Worksheet_SelectionChange codes and replace with this one.
I've assumed that T9:CR43 all have Data Validation.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Cells.Count > 1 Then Exit Sub
  If Application.Intersect(Target, Range("T9:CR43")) Is Nothing Then Exit Sub
  Application.ScreenUpdating = False
  
  ' Clear the color of all the cells
  Cells.Interior.ColorIndex = 0
  
  With Target
  ' Highlight the entire row and column that contain the active cell
  .EntireRow.Interior.ColorIndex = 15
  .EntireColumn.Interior.ColorIndex = 8
  
    ' Add the column heading as Data Validation input message
    With .Validation
      .InputTitle = "Column Heading"
      .InputMessage = Cells(7, ActiveCell.Column).Value
    End With
    
  End With
  Application.ScreenUpdating = True
End Sub

 

[elmar007]

Hi Peter

After days of puzzling I worked it out!!!

I feel a bit of a duh brain as it was so simple!

Your code is perfect....my application of it is not. Basically I ran the code over merged cells, when I unmerged it was perfect!

Thank you for perservering with me

cheers
RM

 

[Peter_SSs]

I ran the code over merged cells, when I unmerged it was perfect!

Glad you got there in the end.

Merged cells can cause many problems, especially when using code. The topic comes up from time to time in this forum. Here's one of them - you may be interested in taking a look.