some rows wanted

[JEPEDEWE]

I have this filtering problem

In the first row of my spreadsheet I have 3 values: B, LL and LK

I want to be able to filter the sheet on one of these values BUT, the title of the items shoul be seen as well:
example
in the attachement
when I choose to filter on LK I get to see all LK items together with their title (in this case 2.12) (and finally title 2 as well)

choose B I see all "B-items" with title 2.10 and 2.11 (and also title 2)

any idea?
Thanks
JP

[mancubus]

A75 = B / A80 = B / A84 = LKLL

font colors = white.
filter criteria = "contains"

[JEPEDEWE]

I made the extra changes you suggest but the rest isn't clear to me???

Would like a user-friendly "interface" to filter

Thanks

[mancubus]

sorry...
"contains" is not a filter criteria...


2003: Data | Filter | AutoFilter
click on the filter arrow for filter options.
select "custom"
select "contains" (left) - your criterion (right) (B or LL or LK)

2010: Data | Sort & Filter | Filter
click on the filter arrow for filter options.
select "text filters"
select "contains"
your criterion (right) (B or LL or LK)

we use contains because you have multiple values for heading 2.12 (LL, LK)

[mancubus]

you may also like easyfilter add-in

http://www.rondebruin.nl/easyfilter.htm

[JEPEDEWE]

hey,
thanks for your reply

The sheet is ment to be used by some collegues in our school, not really excel-users
This sheet all has to do with safety procedures for our (disabled) children
that is why I would like to have a more user-friendly interface then learning them to walk through te different menu-items
Installing extra add-in.... could be OK but I doubt it...

So maybe......

Thanks:dunno

[shrivallabha]

You can do this using VBA. People there need to Enable Macros and then following macro will work when users Double Click in Cell A1 provided they have a valid entry. To use this code, you need to right click on the Sheet Tab and then choose "View Code" option. Paste this code in the new window that pops up.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rMatch As Range, rHide As Range
Dim lLastRow As Long
lLastRow = Range("A" & Rows.Count).End(xlUp).Row
Cells.EntireRow.Hidden = False
If Target.Address = "$A$1" And Target.Value <> "" Then 'Refers to cell A1
For i = lLastRow To 2 Step -1
If Range("A" & i).Value = Target.Value Then
If rMatch Is Nothing Then
Set rMatch = Range("A" & i)
Set rMatch = Union(rMatch, Range("B" & i).End(xlUp).Offset(, -1))
Else
Set rMatch = Union(rMatch, Range("A" & i))
Set rMatch = Union(rMatch, Range("B" & i).End(xlUp).Offset(, -1))
End If
End If
Next i
For i = lLastRow To 2 Step -1
If Intersect(rMatch, Range("A" & i)) Is Nothing Then
If rHide Is Nothing Then
Set rHide = Range("A" & i)
Else
Set rHide = Union(rHide, Range("A" & i))
End If
End If
Next i
End If
If Not rHide Is Nothing Then rHide.EntireRow.Hidden = True
End Sub


And in case they need to remove row hiding then use the sub below:
Public Sub ResetHidden()
Cells.EntireRow.Hidden = False
End Sub

[JEPEDEWE]

Hey thanks a lot...

I did what you suggested...
It works but, not fully correct
I entered B, doubleclicked... got about 5 rows with LK in column 1
Can you leave the blanc lines between the chapters?
Can you leave the first 8 rows?

Is it possible to have a dropdown box in cell A1, now I have the coise of B, LK or LL but maybe there will be more in the future

See you (hopefully)

(if you want I can send you the file, but don't want to bother you too much)
JP

[shrivallabha]

1. For Dropdown, look into Data Validation.

2. Rest of the requirements shall now be satisfied with:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rMatch As Range, rHide As Range
Dim lLastRow As Long
Cells.EntireRow.Hidden = False 'Sequence was incorrect here
lLastRow = Range("A" & Rows.Count).End(xlUp).Row 'Sequence was incorrect here
If Target.Address = "$A$1" And Target.Value <> "" Then 'Refers to cell A1
For i = lLastRow To 9 Step -1 'First 8 rows ignored
If Range("A" & i).Value = Target.Value Then
If rMatch Is Nothing Then
Set rMatch = Range("A" & i)
Set rMatch = Union(rMatch, Range("B" & i).End(xlUp).Offset(, -1))
Else
Set rMatch = Union(rMatch, Range("A" & i))
Set rMatch = Union(rMatch, Range("B" & i).End(xlUp).Offset(, -1))
End If
ElseIf Range("B" & i).Value = "" Then
Set rMatch = Union(rMatch, Range("A" & i))
End If
Next i
For i = lLastRow To 9 Step -1 'First 8 rows ignored
If Intersect(rMatch, Range("A" & i)) Is Nothing Then
If rHide Is Nothing Then
Set rHide = Range("A" & i)
Else
Set rHide = Union(rHide, Range("A" & i))
End If
End If
Next i
End If
If Not rHide Is Nothing Then rHide.EntireRow.Hidden = True
End Sub


3. I am attaching the sample workbook that I used for testing.

[JEPEDEWE]

Hallo,

I get an error 5 message at following line:

Set rMatch = Union(rMatch, Range("A" & i))

When I enter LK or LL or something completly different

When I enter B, the same problem as before

Sorry

JP

[shrivallabha]

Excel is acting weird when I am trying to test it with your workbook.

I have added error handling part and set enableevents to false if the code causes them.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rMatch As Range, rHide As Range
Dim lLastRow As Long

Cells.EntireRow.Hidden = False 'Sequence was incorrect here
lLastRow = Range("A" & Rows.Count).End(xlUp).Row 'Sequence was incorrect here

Application.EnableEvents = False

If Target.Address = "$A$1" And Target.Value <> "" Then 'Refers to cell A1
For i = lLastRow To 9 Step -1 'First 8 rows ignored
If InStr(Range("A" & i).Value, Target.Value) > 0 Then
If rMatch Is Nothing Then
Set rMatch = Range("A" & i)
Set rMatch = Union(rMatch, Range("B" & i).End(xlUp).Offset(, -1))
Else
Set rMatch = Union(rMatch, Range("A" & i))
Set rMatch = Union(rMatch, Range("B" & i).End(xlUp).Offset(, -1))
End If
ElseIf Range("B" & i).Value = "" Then
If rMatch Is Nothing Then
Set rMatch = Range("A" & i)
Else
rMatch = Union(rMatch, Range("A" & i))
End If
End If
Next i
If rMatch Is Nothing Then MsgBox "The specified keyword is not found!": GoTo ErrorHandle
For i = lLastRow To 9 Step -1 'First 8 rows ignored
If Intersect(rMatch, Range("A" & i)) Is Nothing Then
If rHide Is Nothing Then
Set rHide = Range("A" & i)
Else
Set rHide = Union(rHide, Range("A" & i))
End If
End If
Next i
End If
If Not rHide Is Nothing Then rHide.EntireRow.Hidden = True
ErrorHandle:
Application.EnableEvents = True
Set rMatch = Nothing
Set rHide = Nothing
End Sub

[JEPEDEWE]

I copied an pasted your code
did a B filter
All B values were deletd from column A
and the filtering wasn't correct either... no errormessages

sorry mate

JP

[shrivallabha]

This is not my day. And I realize, I am sc***ing yours as well, I am sorry. Try this routine and see if it works as per basic logic:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rToCheck As Range, r As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
Cells.EntireRow.Hidden = False
If Target.Value <> "" And Target.Address = "$A$1" Then
Set rToCheck = Range("A9:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each r In rToCheck
If r.Offset(, 1).Value = "" Then
'Do nothing
ElseIf InStr(r.Value, Target.Value) = 0 Then
r.EntireRow.Hidden = True
End If
Next r
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

[JEPEDEWE]

Hey, may thanks for your code

I think the filtering is correct now...
Column A is hidden now and I changed the cell to enter the filteringvalue to B1...

no problem so far, but, when you enter "LL" as filter the screen is very cluttery... a lot of space between the different titles...
I hope it is possible to do something about this??

Also, I don't arrive in entering a listbox to choose the filter-value from

Hope you are willing to help a bit more

Thanks you so much (attache the modified file)

JP, Belgium

[shrivallabha]

OK. Here's a version which I think is better on all counts. I have added data validation (B, LL, LK) to cell B1. I have added "ALL" to the list if in case a person wants to see ALL cases. I have changed event from 'double click' to 'change' so in effect you will see the sheet getting changed as soon as you change cell B1.
I have split the sub in two parts with a public variable rTarget to pass values from worksheet change.
Public rTarget As Range

Then worksheet change based event
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value <> "ALL" And Target.Address = "$B$1" Then
Set rTarget = Target
Call HideSpecificRows
Else
Cells.EntireRow.Hidden = False
End If
End Sub
Which calls this routine if the keyword is other than 'ALL'.
Private Sub HideSpecificRows()
Dim rToCheck As Range, r As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
Cells.EntireRow.Hidden = False
Set rToCheck = Range("A8:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each r In rToCheck
If InStr(r.Value, rTarget.Value) = 0 Then
r.EntireRow.Hidden = True
End If
Next r
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


I have attached workbook.

[JEPEDEWE]

first impression.... perfect... so many thanks
JP

[JEPEDEWE]

I tested the worksheet... it works just fine now! thanks a lot...
Don't know if I dare to ask something extra....
Is it possible to have a "colour-filter" too...
Suppose I want to get all items with a red rectangle... (dangerous situations for our kids) can I filter them out as well
(either together with the filter you created or seperated)
hope it is possible, would be great... would make the info very easy to get...
Thanks for your efford, whish I could do something in return
JP

[JEPEDEWE]

maybe a bit of informaion about the sheet..

We use it to give our disabled kids a better treatment
When treating our kids, you have to look out for some processes
THe filter you already made, gives a list of processed importoand for 3 different groups of therapists
the colour rectangle highlights the importnace (sometimes danger) of the treatment
So getting a filter on both items could highlight all dangerous or safe treatments per therapist.... would be a great tool!
Thanks (also in name of our kids and therapists)
JP

[shrivallabha]

Sorry for late reply, it was my son's 2nd birthday so busy with him and family.

Its pretty much gettable idea. Could you tell me which cell / column shall I refer to. We can place this filter adjacent to the the first one.

[JEPEDEWE]

it all has to do with columns L M N

Happy birthday to you son... mine is 24 so... long time ago

Thanks
JP

[shrivallabha]

Hi,

Thanks for the wishes. I guess, following shall work. Only thing that you need to do is match colors (Shades of Red, Orange & Green) used in Cells L6, M6 & N6 in the rows where you want to set color filter as my code refers to these cells for color match. Currently they do not match except column L (Red). Especially the selectionchange event color setting.

The color filter is set in Cell K1. This was a bit of rework as I had not considered such possibility while doing the first part.

This is the main event which looks at which filter is being used: B1 or K1
Public rTarget As Range
Public iCol As Integer
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Address = "$B$1" Then
Set rTarget = Target
Call HideSpecificRows
ElseIf Target.Address = "$K$1" Then
If Target.Value <> "None" Then
If Target.Value = "Red" Then iCol = 12
If Target.Value = "Orange" Then iCol = 13
If Target.Value = "Green" Then iCol = 14
Set rTarget = Range("B1")
Call HideColoredRows
Else
Set rTarget = Range("B1")
Call HideSpecificRows
End If
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Some conditions needed shifting from above event to this routine.
Private Sub HideSpecificRows()
Dim rToCheck As Range, r As Range
If rTarget.Value = "ALL" Then
Cells.EntireRow.Hidden = False
Else
Cells.EntireRow.Hidden = False
Set rToCheck = Range("A8:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each r In rToCheck
If InStr(r.Value, rTarget.Value) = 0 Then
r.EntireRow.Hidden = True
Else
r.EntireRow.Hidden = False
End If
Next r
End If
End Sub
And before applying color filter it reworks the base filter in B1 as this sub calls Sub above "HideSpecificRows".
Private Sub HideColoredRows()
Dim rColCheck As Range, r As Range
Call HideSpecificRows
Set rColCheck = Range("B8:B" & Cells(Rows.Count, 2).End(xlUp).Row) _
.SpecialCells(xlCellTypeVisible)
For Each r In rColCheck
If Cells(r.Row, iCol).Interior.Color <> Cells(6, iCol).Interior.Color Then _
r.EntireRow.Hidden = True
Next r
End Sub

I am attaching the revised workbook.

[JEPEDEWE]

Hi...
Tried to change the code for the colour....
Green works now, but orange (255,204,0) doesn't... strange
send you the modified file

Thanks again
JP

[JEPEDEWE]

Hi,

In filtering the colour, I loose my titles

Can I move the listboxes to a more "user-friendly" location
Change the englich names into dutch ones?
(red=rood, green=groen, orange=oranje, none=geen, All=alle)

thanks
JP

[shrivallabha]

Hi,

I have changed the location of the color option to C1 which is next to the filter in B1. I have used the Dutch substitutes as you have provided.

For time being I have removed the other selectionchange macro. Now the rest of the code works fine on all colors.

I am attaching the file.

[JEPEDEWE]

Sorry to keep bothering you...:(

As I noticed before, when filtering on colours, I loose the titles...:dunno
This doesn't happen when I filter on LL or LK or B

Could you change the code to keep the titles after selecting a colour???

What's the use of the red cel L1???

Hope I still ca count on you so close to the end! (to perfection)

Thanks a lot for your time spend on this project :bow:

JP

[shrivallabha]

Well, whatever that I know about VBA is mostly due to VBAX. I come here to learn things.

What I have done is adding the color to the heading row so you won't lose them. To make the logic clear, I have added comments to cell L10, L15 and L19 of the revised workbook. Reading them shall clarify my idea to you.

The red color in L1 was after effect of the selectionchange macro which I deleted. I have removed the color.

Somewhere, you stated the purpose of this sheet (Children's cause). I am a contributor of Plan India organization which works for orphans. So this will make me happier if it works for you.

I am attaching revised workbook.

[JEPEDEWE]

sorry to say, the filtering works, but the "clicking-to-get-a-colour" no longer works.....maybe you deleted too much... I don't know

I already work 31 years with disabled children, age from 12 to 19-20.
some have a mental handicap some have serious character problems...

I love my job very much...

The sheet helps us to see where our kids run into dangerous situations and what we can do about this.
The progamr is not really for me personally since I am a fysical therapist, the sheet should help some of my collegues.

Thanks for your very kind help

(not for me personally but for our kids!!... thanks a lot)
JP

[shrivallabha]

Hi,

Now you have confused me. There is no change in the code whatsoever from the previous post. So there is nothing deleted.

The only changes that I have made are in the cells L, M & N of Titles. I have added relevant colors so that the Title row does not hide when the code runs. Have you read the comments written? Move the mouse cursor over the cells L10, L15 and L19 to read comments.

The filters work perfectly for me so I can not replicate the problem here. Sorry for that.

Can you please upload the workbook where it is not working for you so that I can compare?

[JEPEDEWE]

Strange... I send you the file...

click on one of the cells in column L or M or N or O... the corresponding color should be applied, but nothing happens

I send you the file with a working color-thing
please see the difference with the latest one you send where the color-thing doesn't work

also, in this file, cell O1 has no cell edge...dono why

Thanks mate!
JP

[shrivallabha]

This is not the latest! Ah, I think that could be the problem.
Please download the one posted at post number#26 and check or see the attached file in this reply.

This time I have added word Final to its name so that old and new don't get mixed up ;)

[JEPEDEWE]

this is very strange... nor your latest version nor the version of reply 26 work...
Clicking the cell should change the cell-color... but nothing happens in both files. In my uploaded file the color program works just fine but the rest doesn't
.... complicated

JP:dunno

[shrivallabha]

No, that isn't strange. As I have specified in the post #24, the macro which colors your cells is removed.

Do you need the "selectionchange" macro?
I think this is what it does:
When you click on L, M or N column it assigns color to the specific column based on the column number and removes the color from the other two columns (as only one color will be applicable?). Can you clarify or confirm your requirement? I can work it out then!

[JEPEDEWE]

seen #29... this file does exactly what it should do with the color-cells...
Hope you can solve this problem!
thanks a lot
JP

[shrivallabha]

seen #29... this file does exactly what it should do with the color-cells...
Hope you can solve this problem!
thanks a lot
JP
OK. I refered to the code. Based on understanding and your additional requirement, I have written code as below. This is similar to old code in logic.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'********************************************************************
'This code applies to Column L, M, N & O columns
'Applies color to the selected cell based on column
'Execution of this code calls for another sub updateheading
'********************************************************************
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Count > 1 Or Target.Row < 11 Then GoTo EOSub
If Target.Column < 12 Or Target.Column > 15 Then GoTo EOSub
Set rcTarget = Target
Select Case Target.Column
Case 12
Range("L" & Target.Row).Interior.ColorIndex = 3
Range("M" & Target.Row).Interior.ColorIndex = -4142
Range("N" & Target.Row).Interior.ColorIndex = -4142
Range("O" & Target.Row).Interior.ColorIndex = -4142
Call UpdateHeading
Case 13
Range("L" & Target.Row).Interior.ColorIndex = -4142
Range("M" & Target.Row).Interior.ColorIndex = 46
Range("N" & Target.Row).Interior.ColorIndex = -4142
Range("O" & Target.Row).Interior.ColorIndex = -4142
Call UpdateHeading
Case 14
Range("L" & Target.Row).Interior.ColorIndex = -4142
Range("M" & Target.Row).Interior.ColorIndex = -4142
Range("N" & Target.Row).Interior.ColorIndex = 43
Range("O" & Target.Row).Interior.ColorIndex = -4142
Call UpdateHeading
Case 15
Range("L" & Target.Row).Interior.ColorIndex = -4142
Range("M" & Target.Row).Interior.ColorIndex = -4142
Range("N" & Target.Row).Interior.ColorIndex = -4142
Call UpdateHeading
End Select
EOSub:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

However, this code does not handle updating titles and adding that code to the above event would have made it messy.
Private Sub UpdateHeading()
'********************************************************************
'This code updates Title color based on subordinate cells color
'This code gets executed when selectionchange event occurs & applies!
'********************************************************************
Dim lTop As Long, lBot As Long
Dim bColRed As Boolean, bColOra As Boolean, bColGre As Boolean
lTop = Range("B" & rcTarget.Row).End(xlUp).Offset(1, 0).Row
If Range("B" & rcTarget.Row).Offset(1, 0).Value = "" Then
lBot = rcTarget.Row
Else
lBot = Range("B" & rcTarget.Row).End(xlDown).Row
End If
For i = lTop To lBot
If Range("L" & i).Interior.ColorIndex = 3 Then bColRed = True
If Range("M" & i).Interior.ColorIndex = 46 Then bColOra = True
If Range("N" & i).Interior.ColorIndex = 43 Then bColGre = True
Next i
If bColRed = True Then
Range("L" & lTop - 1).Interior.ColorIndex = 3
Else
Range("L" & lTop - 1).Interior.ColorIndex = -4142
End If
If bColOra = True Then
Range("M" & lTop - 1).Interior.ColorIndex = 46
Else
Range("M" & lTop - 1).Interior.ColorIndex = -4142
End If
If bColGre = True Then
Range("N" & lTop - 1).Interior.ColorIndex = 43
Else
Range("N" & lTop - 1).Interior.ColorIndex = -4142
End If
End Sub

I am attaching the updated workbook. I have added R0 to the name for easy identification.

[JEPEDEWE]

OK, I understand, however, 2 remarks (sorry)

now, only titles form level 2 are displayed (2.1 or 2.3 or whatever) but not a level 1 title (example 2 when 2.1 or 2.3 are selected)
Is it possible to set the color next to the titles invisible??? looks cluttery after filtering now...

Thanks

JP

[shrivallabha]

OK, I understand, however, 2 remarks (sorry)

now, only titles form level 2 are displayed (2.1 or 2.3 or whatever) but not a level 1 title (example 2 when 2.1 or 2.3 are selected)
Is it possible to set the color next to the titles invisible??? looks cluttery after filtering now...

Thanks

JP
1. It will be difficult to set Titles color with the current sheet layout.

2. With the second request, you have confused me. Let me understand following:
The code for changing colors is for quick change by clicking on respective column. So if these columns are invisible, then you will have to make them visible to change colors. Aren't these two requests opposite.

If the coloring in the cells remains constant then why not do it once manually as I had done before?

[JEPEDEWE]

1. do you think it is doable??? just asking
2. now it works perfect but because of the cluttery result (after color-filtering), I thought, maybe it is possible to hide the colors next to the titles so the outcome looks better (or to place the colors in colums P Q R S and to hide them... or to change the colors next to the titles into white characters... dono what would be possible)

can I add 2 extra rows (3 - 4) so I can place the title of the sheet (D1) in cell C3....

Thanks

[JEPEDEWE]

I encountered a few errors...

Example: row 15 and 19 (title-items), I can change the color-rectangles... how can I prevent it form being edited

When I change colors in row 26 (what should not be possible) the rectangles in 24 are modified.... strange

JP

[shrivallabha]

1. do you think it is doable??? just asking
2. now it works perfect but because of the cluttery result (after color-filtering), I thought, maybe it is possible to hide the colors next to the titles so the outcome looks better (or to place the colors in colums P Q R S and to hide them... or to change the colors next to the titles into white characters... dono what would be possible)

can I add 2 extra rows (3 - 4) so I can place the title of the sheet (D1) in cell C3....

Thanks
2. I will answer 2nd first. I have shifted it further to Q R S T. So had to jump around in the coding. I think, you should not hide them but it is just my opinion, change it the way you like. If you don't require it, we can still remove the code and do the setup manually. That will spare us from one complete event.

1. This part is little trickier but I think, I have managed it by writing really ugly bit of code as below:
Private Sub MainHeadingCheck()
'********************************************************************
'This code updates The main title colors
'This code gets executed when selectionchange event occurs & applies!
'********************************************************************
Dim rTitle As Range, rTCheck As Range
Dim lLast As Long
Dim iMax As Integer
Dim sSearch As String
Dim vSecCheck As Variant
Dim bTColRed As Boolean, bTColOra As Boolean, bTColGre As Boolean

'********************************************************************
'Collecting the titles based on number on left side
'********************************************************************
For i = 10 To Range("B" & Rows.Count).End(xlUp).Row
If IsNumeric(Left(Trim(Range("B" & i).Value), 3)) Then
vSecCheck = Split(Range("B" & i).Value, ".")
If IsNumeric(vSecCheck(1)) Then
If rTitle Is Nothing Then
Set rTitle = Range("B" & i)
Else
Set rTitle = Union(rTitle, Range("B" & i))
lLast = i
End If
End If
End If
Next i
'********************************************************************
'Checking the highest heading number which is currently 10
'********************************************************************
vSecCheck = Split(Trim(Range("B" & lLast).Value), ".")
iMax = vSecCheck(0)
For i = 1 To iMax
'********************************************************************
'Very similar logic to UpdateHeading sub but only titles are checked!
'********************************************************************
For Each rTCheck In rTitle
vSecCheck = Split(Trim(rTCheck), ".")
If CStr(i) = vSecCheck(0) Then
If Range("Q" & rTCheck.Row).Interior.ColorIndex = 3 Then bTColRed = True
If Range("R" & rTCheck.Row).Interior.ColorIndex = 46 Then bTColOra = True
If Range("S" & rTCheck.Row).Interior.ColorIndex = 43 Then bTColGre = True
End If
Next rTCheck

sSearch = i & ". "

'********************************************************************
'Finding the header row which matches sSearch and setting its colors!
'********************************************************************
For j = 10 To Range("B" & Rows.Count).End(xlUp).Row
If Left(Trim(Range("B" & j).Value), 3) = sSearch Then
If bTColRed = True Then
Range("Q" & j).Resize(2, 1).Interior.ColorIndex = 3
bTColRed = False
Else
Range("Q" & j).Resize(2, 1).Interior.ColorIndex = -4142
End If
If bTColOra = True Then
Range("R" & j).Resize(2, 1).Interior.ColorIndex = 46
bTColOra = False
Else
Range("R" & j).Resize(2, 1).Interior.ColorIndex = -4142
End If
If bTColGre = True Then
Range("S" & j).Resize(2, 1).Interior.ColorIndex = 43
bTColGre = False
Else
Range("S" & j).Resize(2, 1).Interior.ColorIndex = -4142
End If
End If
Next j
Next i
End Sub

[shrivallabha]

I encountered a few errors...

Example: row 15 and 19 (title-items), I can change the color-rectangles... how can I prevent it form being edited

When I change colors in row 26 (what should not be possible) the rectangles in 24 are modified.... strange

JP
It is just that one reply would big to read, I have split my reply.

Your observation is correct. I missed it completely. But that should be applicable where Column B is blank e.g. B16, B20 also. So I have added two checkpoints to selection change event as below:
If Range("B" & Target.Row).Value = "" Then GoTo EOSub
If Range("B" & Target.Row).Offset(-1, 0).Value = "" Then GoTo EOSub

I have added two more rows as you specified. Please do not add rows as I have hard coded the starting row part and then code will not work correctly.

I am attaching the revised file. I have changed the revision from R0 to R1.0 to avoid confusion.

[JEPEDEWE]

thanks for your reply
Sorry for MY late reply, had a few days off... no computer

This file confuses me a lot... the color-cells are no longer in row L M N O and don't work like they did before, or do't work at all... could you please take a look

thank you soo much and sorry for all the trouble

JP

[shrivallabha]

thanks for your reply
Sorry for MY late reply, had a few days off... no computer

This file confuses me a lot... the color-cells are no longer in row L M N O and don't work like they did before, or do't work at all... could you please take a look

thank you soo much and sorry for all the trouble

JP
As you have requested earlier, I have pushed the color coding as below:
L ---> Q (Rood)
M ---> R (Oranje)
N ---> S (Groen)
O ---> T (Geen)
So now you will have to click in column Q, R, S, T.

The coloring part, will look confusing [result of requests], but it will give you better color-filter results with heading. Check the color filtering.

Now, the color change occurs only in the ranges which are neither title nor blank cell. To reduce your confusion what I have done is:
Border cells which need the color changing ability. e.g. Row 13, 14 and 15.

See attachment

[JEPEDEWE]

Sorry, misunderstanding...
I don't want the "color-cells" of the items themselves in column QRST
What I suggested was the following (hoope I can explain it better now)
Leave the "color-cells" in column LMNO (immediatly next to the items, BUT
if the "cdolor-cells" of the TITLES, would be in column QRST, you could, maybe hide these colums to increase readability...
(do you understand what I try to explain now???... hope you do!)

Also, when I change the color in row 13 -14 -15... the color of cells in row 16 changes too.... ????

Sorry to bother you soo much
JP

[shrivallabha]

The change in color at row 16 improves readability when you set color filter (earlier title and blank row would be invisible when we used color filter).

I don't think, setting title color in different is bright and good idea [especially from coding perspective]. And hiding will be worse. I am already observing a slow down due to code and event overload (thanks to my programming:devil2: ).

So it will be good, if we leave it the way it is right now!

[JEPEDEWE]

Sorry Shrivallabha, but the way it works now is verry confusing
Would it be easier if we no longer use colors but characters in the "color-cells"?
JP

[JEPEDEWE]

We had a discussion over here... is it easier to write the code if we would drop the color-stuff and enter characters 1 - 2 - 3 to indicate "green-orange-red"
??? hope youy still want to help me out!

Many thanks

JP

[shrivallabha]

Refer column M for setting colors. The cells that should need color have Data Validation (In cell dropdown) e.g. M13, M14 & M15 etc. Title and blank row do not have them. The reason for choosing column M is it leaves one blank cell between the color cell and data (clutter removal).

Select the color from your set [rood, oranje, groen]. The cell color will be set based on color selection so that you can easily identify the color selected.

I think, I have tried almost everything that I know. I hope you will understand. I am attaching what could be my last attempt at this excercise!

[JEPEDEWE]

Looks good now... great!
Will check some thing out

Many thanks for your effords.... whish I could do something in return

JP

[JEPEDEWE]

if I may.... 2 questions
Whan I want to add new items, is it OK for the code to copy-past current rows and change the text in column B??
Can I change the color of the text in the listboxes??? now I get a green cel with the text "Green"... I understand this text is needed for the filtering but if I could change the color of the text itself in the same color as the cell the text would be hidden (I read something like Target.Interior.ColorIndex in de code, maybe I could change something here)
sorry to have bothered you!
thanks
JP

[shrivallabha]

if I may.... 2 questions
Whan I want to add new items, is it OK for the code to copy-past current rows and change the text in column B??
Can I change the color of the text in the listboxes??? now I get a green cel with the text "Green"... I understand this text is needed for the filtering but if I could change the color of the text itself in the same color as the cell the text would be hidden (I read something like Target.Interior.ColorIndex in de code, maybe I could change something here)
sorry to have bothered you!
thanks
JP

1. Yes. I want to you to understand the concept of Data Validation. Search it up on google. The listboxes are data validation.

You can copy and change the contents as you need. See Excel's option of Copy>Paste Special>Validation in column M.

2. Use
Target.Font.ColorIndex = 3

I am attaching the revised workbook for your ease.

[atc2323]

I have added two more rows as you specified. Please do not add rows as I have hard coded the starting row part and then code will not work correctly.

I am attaching the revised file. I have changed the revision from R0 to R1.0 to avoid confusion.

[shrivallabha]

I have added two more rows as you specified. Please do not add rows as I have hard coded the starting row part and then code will not work correctly.

I am attaching the revised file. I have changed the revision from R0 to R1.0 to avoid confusion.




I suspect "spam" post!

[JEPEDEWE]

atc2323 is surely not me! so indeed... "spam"
Thanks for your kind help
Will check things out and then... hopefully start to use the sheet!

Greetz

JP