PDA

View Full Version : Solved: Cells as Checkboxes to Filter



IgnBan
02-28-2008, 09:43 PM
I have a workbook that keeps track of units been repair and I?m developing a way to visually show the ?Repaired? and the ?Waiting for Repair? units as part of and of ongoing project. The goal is to ?Check off? the ones repaired in Sheet1, and filter in Sheet2 the ?Needs Repair Units?. Ultimately trigger the Sheet 2 Filter with the ?check off? event.
In Sheet1 I have 4 columns; ?Check on/off? , ?Status?, ?Item Number? and ?Discrepancy? fields.
On Sheet2 ?Item Number? and ?Discrepancy? filtered from Sheet1
I was thinking use checkboxes, but searching the KB found a great code that makes better sense; it uses the cells as a check boxes.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("myChecks")) Is Nothing Then Exit Sub
'set Target font tp "marlett"
Target.Font.Name = "marlett"
'Check value of target
If Target.Value <> "a" Then
Target.Value = "a" 'Sets target Value = "a"
Cancel = True
Exit Sub
End If
If Target.Value = "a" Then
Target.ClearContents 'Sets Target Value = ""
Cancel = True
Exit Sub
End If
End Sub



What I need to do is as the ?Unit? is enter in Sheet1 cell "B" make the ?Status? field show ?Needs Repair? in cell ?B? and by using the code double clicking cell ?A? change it to ?Ready?. I?ve done some conditionally formatting and If?s statements but can't make it work.
In a nut shield in Sheet1, cell ?B? will be controlled by; if cell ?C? is empty show ?? and if cell ?C? show any number, then show ?Needs Repair?, but when cell ?A? is double clicked (triggering code) then cell ?B? will show ?Ready?

Also is it possible to filter Sheet2 without empty rows?
I have attached a workbook with sample code and sheets example.
Any help is in advance greatly appreciated.:thumb

Bob Phillips
02-29-2008, 02:26 AM
Most of it seems to be there already.

IgnBan
02-29-2008, 05:57 AM
Xld, thanks for replaying to my post.

and filter in Sheet2 the ?Needs Repair Units?.I look at you code and can find where to change it to filter the "Needs Repair" insted of ready . Can you tell me the logic you are using.


In a nut shield in Sheet1, cell ?B? will be controlled by; if cell ?C? is empty show ?? and if cell ?C? show any number, then show ?Needs Repair?, but when cell ?A? is double clicked (triggering code) then cell ?B? will show ?Ready?
Also how do I do about when in Sheet1 when a unit number is enter show "Needs repair" and when the Unit Number is removed show empty cell ""?

Xld, thanks again!

Bob Phillips
02-29-2008, 06:48 AM
Change this line in the sheet 2 code



Do Until .Cells(mpTargetRow, "B").Value <> ""


to



Do Until .Cells(mpTargetRow, "B").Value = ""


I don't see the logic of the second bit. Why would it be needing repair just because it has an item number? What purpose does the checkmark serve in that instance?

Bob Phillips
02-29-2008, 06:51 AM
I get the second part now.

Chnage the formula in B2 to

=IF(C2="","",IF(A2="A","Ready","Needs Repair"))

and copy it down.

IgnBan
02-29-2008, 08:32 AM
Xld, the code is already in you modifyed workbook as you are suggesting :think:

Do Until .Cells(mpTargetRow, "B").Value = ""

P S
Change of IF statment resolved the other problem.

Bob Phillips
02-29-2008, 09:04 AM
I gave the wrong line. I meant change



If .Cells(mpTargetRow, "A").Value <> "" Then


to



If .Cells(mpTargetRow, "A").Value = "" Then

IgnBan
02-29-2008, 09:28 AM
Xld, tryed that before and it give me a syntax error

lenze
02-29-2008, 11:05 AM
Combine the Before_DoubleClick with a Change event


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Target.Column <> 1 Then Exit Sub
If Target.Value <> "Ready" Then
Target.Value = "Ready" 'Sets target Value = "Ready"
Cancel = True
Exit Sub
End If
If Target.Value = "Ready" Then
Target.ClearContents 'Sets Target Value = ""
Cancel = True
Exit Sub
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 2 Then Exit Sub
If Target <> "" Then Cells(Target.Row, 1) = "Not Ready"
End Sub

lenze

david000
02-29-2008, 12:01 PM
Ultimately trigger the Sheet 2 Filter with the “check off” event.


Edit: oops, I didn't read that part...nevermind



Sub macro_1()

With Sheet1

Range("a1").AutoFilter
Range("a1").CurrentRegion.Name = "data"
Range("data").AutoFilter Field:=2, Criteria1:="Needs Repair"
Range("data").SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheet2.Range("a1")
Application.CutCopyMode = False
Range("a1").AutoFilter 'toggles it off

End With

End Sub

IgnBan
02-29-2008, 02:13 PM
Ok, thanks guys.
First of all I want to recongnize and thanks Lenze, he is the "Alternative Check boxes" KB entry owner :clap: , and one of his options code is been use here in the first post...."Second of all" let's get organized!;
Lenze, is you code replacing the original as in your example workbook or the one posted originaly here with Xld modifications? where does you code fits? I used with the one with the original post workbook and prints "Ready" on column "A", it also doesnt update the "Sheet2" cells.
David000, when I use your code in the last xld sumited workbook , it does change Sheet2 when entering a "Unit" in Sheet1, but it doesnt update Sheet2 when double click (check) Sheet1 "A" coulunm? How are you suggesting using it, with Lenze code sample or xld modificated workbook?

Thanks for the input guys

Any Ideas?

Bob Phillips
02-29-2008, 04:08 PM
Don't know about anyone else, but I am totally confused as to what works, what doesn't, what is being used, what is being discussed etc. A case of too many cooks methinks ...

IgnBan
02-29-2008, 04:22 PM
You are right Xld, lets just finish what we started. I think is the one already almost finish. xl you confused me too, in your last post s you said to change
Do Until .Cells(mpTargetRow, "B").Value <> ""
to
Do Until .Cells(mpTargetRow, "B").Value = ""

but

[vba]Do Until .Cells(mpTargetRow, "B").Value = ""

is already this way in you last summited code

All I need is to "Needs Repair" show in Sheet2, insted of "Repaired"

Can you light our way? :bow:

Bob Phillips
02-29-2008, 04:54 PM
I corrected tha in post #7 in this thread.

Bob Phillips
03-01-2008, 03:03 AM
Maybe I didn't cater for the changes that can be introduced vby the change in that formula, so I went back and re-cut it to look specifically for 'Need Repair'.

See if this works in all cases now



Private Sub Worksheet_Activate()
Dim mpLastRow As Long
Dim mpNextRow As Long
Dim mpTargetRow As Long

mpLastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
With Me.Rows("2:" & mpLastRow + 50)

.Borders(xlLeft).LineStyle = xlNone
.Borders(xlRight).LineStyle = xlNone
.Borders(xlTop).LineStyle = xlNone
.Borders(xlBottom).LineStyle = xlNone
.ClearContents
End With

mpNextRow = 2
With Worksheets("Sheet1")

mpTargetRow = 2
For Each mpRow In .UsedRange.Rows

If mpRow.Cells(1, "B").Value = "Needs Repair" Then

mpRow.Cells(1, "B").Resize(, 3).Copy
Me.Cells(mpNextRow, "A").PasteSpecial Paste:=xlPasteValues
mpNextRow = mpNextRow + 1
End If
Next mpRow
End With

mpLastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
With Me.Range("A1").Resize(mpLastRow, 3)

.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
.Borders(xlEdgeTop).LineStyle = xlNone
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With

Me.Range("A2").Select
End Sub

coliervile
03-01-2008, 07:05 AM
Good Morning "xld" when I run your coding an error message comes up when there are no Status of "Ready". This error message "Unable to set the LineStyle prperty of the Border class" comes up because there nothing to format since there's no "Ready" in the column...how do you get around this error? Thanks for the lesson....

With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With

Best regards,

Charlie

Bob Phillips
03-01-2008, 07:09 AM
Just add a check that the last row is greater than 1



Private Sub Worksheet_Activate()
Dim mpLastRow As Long
Dim mpNextRow As Long
Dim mpTargetRow As Long

mpLastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
With Me.Rows("2:" & mpLastRow + 50)

.Borders(xlLeft).LineStyle = xlNone
.Borders(xlRight).LineStyle = xlNone
.Borders(xlTop).LineStyle = xlNone
.Borders(xlBottom).LineStyle = xlNone
.ClearContents
End With

mpNextRow = 2
With Worksheets("Sheet1")

mpTargetRow = 2
For Each mpRow In .UsedRange.Rows

If mpRow.Cells(1, "B").Value = "Needs Repair" Then

mpRow.Cells(1, "B").Resize(, 3).Copy
Me.Cells(mpNextRow, "A").PasteSpecial Paste:=xlPasteValues
mpNextRow = mpNextRow + 1
End If
Next mpRow
End With

mpLastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
If mpLastRow > 1 Then

With Me.Range("A1").Resize(mpLastRow, 3)

.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
.Borders(xlEdgeTop).LineStyle = xlNone
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
End If

Me.Range("A2").Select
End Sub

coliervile
03-01-2008, 07:23 AM
That did it, thanks.

Best regards,

Charlie

IgnBan
03-01-2008, 06:10 PM
Thanks everybody for the help. Thanks Xld so the solution.:thumb