• 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.

filter and highlight

I

IKHAN

Member
Hello, Running a macro to sort data(numbers) in column A and applying FILTERS to remove data from column B and after filtering trying to highlight entire row with group of matched numbers in column A with alternate color...


With macro below :

Its highlighting matched numbers first and then filter is applied.

Can i get help in first filter is applied and then on active sheet highlights can run, so tht 2 colors are NOT mixed AND MISSED.

Sub test()
'
' test
'

'
Rows("1:3").Select
Selection.Delete Shift:=xlUp
Cells.Select
Selection.UnMerge
Range("A3").Select
Columns("A:A").ColumnWidth = 11.29
Columns("B:B").ColumnWidth = 12
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").Select
Selection.Delete Shift:=xlToLeft
Columns("I:I").EntireColumn.AutoFit
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("K:K").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
Columns("L:L").Select
Selection.Delete Shift:=xlToLeft
Columns("L:L").EntireColumn.AutoFit
Selection.ColumnWidth = 33.14
Columns("M:M").Select
Selection.Delete Shift:=xlToLeft
Selection.ColumnWidth = 14.29
Columns("N:N").Select
Selection.Delete Shift:=xlToLeft
Columns("O:O").Select
Selection.Delete Shift:=xlToLeft
Columns("O:O").EntireColumn.AutoFit
Columns("P:p").Select
Selection.Delete Shift:=xlToLeft
Columns("Q:Q").Select
Selection.Delete Shift:=xlToLeft
Columns("Q:Q").EntireColumn.AutoFit
Columns("R:R").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.SmallScroll ToRight:=3
Columns("S:S").Select
Selection.ColumnWidth = 40.43
Selection.ColumnWidth = 49.14
Selection.ColumnWidth = 61.71
Columns("T:T").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Cells.Select
ActiveWorkbook.Worksheets("Daily RFC Report").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Daily RFC Report").Sort.SortFields.Add Key:=Range( _
"I2:I373"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Daily RFC Report").Sort.SortFields.Add Key:=Range( _
"A2:A373"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Daily RFC Report").Sort
.SetRange Rows("1:373")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$1:$370").AutoFilter Field:=9, Operator:=xlFilterValues _
, Criteria2:=Array(0, "2/12/2013")
ActiveSheet.Range("$1:$370").AutoFilter Field:=6, Criteria1:=Array( _
"Critical", "Major", "Minor"), Operator:=xlFilterValues
ActiveSheet.Range("$1:$370").AutoFilter Field:=5, Criteria1:=Array( _
"Approved", "Open-Partially Completed", "Under Review"), Operator:= _
xlFilterValues
Cells.Select
Selection.RowHeight = 20.25
Range("C2").Select
ActiveWindow.FreezePanes = True
ActiveWindow.SmallScroll Down:=-12
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
Range("C5").Select
ActiveWindow.SmallScroll Down:=-6
Range("A2").Select

For Each sht In ActiveWorkbook.Sheets
If sht.Visible Then sht.Activate 'only processes visible sheets in a book
Range("A2:A2000").Select 'assumes column A is the column you're interested in
'blah4 'calls previous macro
Next sht

If Selection.Areas.Count > 1 Then Exit Sub 'ensures only one contiguous block selected
HighlightOn = False 'this is flipped true/false everytime a new value is encountered
StartRow = Selection.Row 'First row of selection
EndRow = StartRow + Selection.Rows.Count - 1 'last row of selection
mycolumn = Selection.Column 'leftmost column of selection
FromRow = StartRow 'FromRow is the first row of a new value encountered

Do
r = 1 'holds the number of cells found with a similar value
Do Until Cells(FromRow, mycolumn).Value <> Cells(FromRow, mycolumn).Offset(r).Value Or FromRow + r > EndRow 'comes out of loop if different value encountered or end of selection reached
r = r + 1
Loop 'this loop exits when a different value is encountered
If HighlightOn Then 'highlight the rows
Cells(FromRow, mycolumn).Resize(r).EntireRow.Interior.ColorIndex = 35
HighlightOn = Not HighlightOn 'flip the highlight
Else
HighlightOn = Not HighlightOn 'flip the highlight
End If
FromRow = FromRow + r 'set Fromrow to be the beginning of the next block of cells
Loop Until FromRow > EndRow 'stop when the bottom of the original selection is reached
End Sub
EXAMPLE: After running above macro

[pre]
Code: 
COLUMN A  - COLUMN B
1111      - ABCD (no highlight)
1111      -CDEF  (no highlight)
2222      - AFGD (Highlighted row with green) " Here if filter applied to column B to remove AFGD and FDERF" (2222 is hidden and active sheet shows 1111grp and 3333grp with no highlights and could be missed)
2222      - FDERF (Highlighted row with green)
3333      -dfge(no highlight)
3333      -fegr(no highlight)
[/pre]
 
Hi, IKHAN!


If I could put my hands on the Redmond guys who developed this part of the built-in macro recorder... surely I'd end in jail, I guess. I feel like the little monkey in the joke story about the monkey and the giraffe, do you know it? Well, if not, I'm afraid that it wouldn't be politically correct to post it here, Chandoo loves animals but not to that extent (as a clue, the monkey died of a heart attack because of the successive sprints along giraffe's neck from the head to a little beyond where the back ends.


Before getting my neck broken by the up&down flips, could you please elaborate a bit more, including the upload of a sample file with manual examples? Thank you.


Regards!
 
Yikes! While it IS usually helpful to see the whole context, seeing this block of code if a bit overwhelming! I also see that it does much more than you describe, and most of the code is not commented. =(


I tried trimming it down a little bit, but I'm still not sure which part you want us to focus on. Perhaps if instead of showing us the whole macro, if you elaborate more on what it is you want to do with the sorting/filtering, we can write the script for that, and then include it in part of a larger macro, if need be.
 
@Luke M

Hi!

Would you be my cell mate? But for the time being, I began doingo so but then I decided to wait for IKHAN's (OP, ha ha, I yet know it!!!) file.

Regards!
 
Maybe I'm a sucker for punishment, but I took some more time to read through the code. It's a little strange, as you

1. do some deleting/sizing

2. Set filters on certain sheets

3. Go through all sheets and select A2:A2000

4. On whatever was the last active sheet, we then do some highlighting


Assuming I've followed that correctly, the code you wanted our help on is just the last little block. Restating your problem as "The highlight is being applied to all cells, not just the visible ones", we can fix this with 1 small correction on line 108. =)


Change

Code: 
Cells(FromRow, mycolumn).Resize(r).EntireRow.Interior.ColorIndex = 35

to this:

Cells(FromRow, mycolumn).Resize(r).EntireRow.SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 35
 
Thanks for reply luke!!!


Want to apply alternate highlight after sorting n filtering is done on the active sheet, So that it groups the numbers in column A can be distinguished...I'll try to upload a sample file...

Thanks for all your help guys!!!
 
I Get daily sheet from another co. with around 600 lines of data and i need to sort/filter and highlight row data with matched numbers in Column A and below steps are done manually,I have recorded macro by performing all steps, It gets my job done - except LAST STEP - it highlights data and then filter is applied.


- Need HIGHLIGHT data on active sheet.


1. delete first 3 rows

2. Highlight complete sheet

3. unmerge cells

4. delete EMPTY Columns C,E,G,H,K,M,0,Q,T,V,X,Z,AB,AD,AF,AI

5. SORT by Header row Planned start(column I) - nEWEST DATE TO OLDEST DATE

6. Then by Sort by Header row Prime ID Column A -(Highest to lowest)

6a. Freeze first 2 columns and first row

7.Apply filter to header row (column E to remove"Rejected ,closed" ,Column F to remove "Pre-Auth",Column I to remove anything 1 day prior to present date" example today date is jan 16 2013 ,complete rows to deleted anything before Jan 15 2013)

8.Highlight sheet and maximize columns to fit data

9. On active sheet after filters are applied, highlight same matched numbers in cloumn A complete row with "NO COLOR" and alternate matched number row with "light green
 
Have uploaded sample file for ref.


1.Currently in sheet 3(current ouptut Tab), Its highlighting 3333,6666,8888 together and could be missed while going 600 lines of this data.

2. And also its not deleting 1 day prior date ( example row 8 and 9 (5555)shld be deleted since column I(Planned start date has passed.


3. Looking for output similiar to tab2(output reqd.) and shld be able to edit and modify data after macro is run with reqd output.


Hope have provided info....Really appreciate the help!!!You guys are the best..


https://hotfile.com/dl/189432622/9f07668/Book1vc.xlsx.html
 
You must log in or register to reply here.
Back
Top