Tick Box's

[PHIL.Pearce84]

Hi

I have made a questionaire for our development team and basically want them to be able to click in a cell if it is required and produce a tick is this possible?

Also is it possible to create a cell that will produce a tick in all cells below it?

Thanks

 

[MickG]

This will provide a "Tick" in any cell in range shown, when you click it.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1:F10")) Is Nothing Then
    With Target
        .value = chr(80)
        .Font.Name = "Wingdings 2"
        .Font.Bold = True
    End With
End If
End Sub

 

[PHIL.Pearce84]

Hi

Thanks for your quick response

This works really well but I wonder if you could help me improve what I already have? Basically I have two macros running now, and at the moment when I click in a box to produce the tick it runs the hide rows Macro as well which makes the process quite slow, is there any way to speed it up?

This is what I am using:

Private Sub Worksheet_Calculate()
Dim i As Long
Application.EnableEvents = False
For i = 13 To 205
If i <> 11 Then
Rows(i).Hidden = Range("E" & i).Value = 0
End If
Next i
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("G12:AU206")) Is Nothing Then
With Target
.Value = Chr(80)
.Font.Name = "Wingdings 2"
.Font.Bold = True
End With
End If
End Sub

Thanks

 

[MickG]

Would this work for you ??

Private Sub Worksheet_Calculate()
Dim Rng As Range, Dn As Range
    Set Rng = Range("E13:E206")
    Set Rng = Rng.SpecialCells(xlCellTypeBlanks)
    Rng.rows.Hidden = True
End Sub

 

[PHIL.Pearce84]

I have pasted this over my other hide rows macro but it doesn't seem to do anything?

 

[MickG]

You should repace the old "Calculate " Code with this code.
If any values in column "E" beween rows 13:206 are Blank, it will hide those rows, when you recalculate.
Is that what you wanted ??
Note:- If by any changce you have run half your old code because you where stepping through it, you may have set the "Enable Event" to False which means the code will not run again until you reset it.
Take that line of code "Application.EnableEvents = True" and run it seperately in the sheet to reset.

 

[PHIL.Pearce84]

It is exactly what I need.

Sorry really new to this and can't get my head round it, this is what appears on my screen:

Private Sub Worksheet_Calculate()
Dim Rng As Range, Dn As Range
Set Rng = Range("E13:E206")
Set Rng = Rng.SpecialCells(xlCellTypeBlanks)
Rng.Rows.Hidden = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("G12:AU206")) Is Nothing Then
With Target
.Value = Chr(80)
.Font.Name = "Wingdings 2"
.Font.Bold = True
End With
End If
End Sub

I have also put Application.EnableEvents = True in the immediate box but still nothing.

It I could attached my spreadsheet it would be easier but there does not seem to be an attachment button.

 

[MickG]

I should try this new "Calculate" code in a new sheet, to get it working.
You will see the range to Hide in the "Msgbox ". Remove this line when working OK.

Private Sub Worksheet_Calculate()
Dim i As Long
Dim Rng As Range
For i = 13 To 205
    If Range("E" & i) = 0 Then
        If Rng Is Nothing Then
            Set Rng = Range("E" & i)
        Else
            Set Rng = Union(Rng, Range("E" & i))
        End If
    End If
Next i
MsgBox Rng.Address
Rng.rows.Hidden = True
End Sub

 

[PHIL.Pearce84]

The range of cells it is specifying to hide is perfect and the tick box is not slowing anything down.

When I select the name from a drop down box on the sheet the sum product formula pulls the information across and populates Column E and puts 0's where no information is needed. Your Macros then kicks in and in this case says hide E:72 to E205 which is correct but it doesn't show E13-71?

 

[MickG]

Does it help if you add this line to Unhide any previoulsy hidden rows.

Private Sub Worksheet_Calculate()
Dim i As Long
Dim Rng As Range
ActiveSheet.rows.Hidden = False
For i = 13 To 205
    If Range("E" & i) = 0 Then