Horizontal filtering with macros

filur1

New Member
Joined
Dec 21, 2013
Messages
7
I am struggling making a horizontal filter with macros. Its currently the only way to solve my problem with easily hiding and unhiding a large amount of columns without transposing my data (which is not an option) and using the original filter.

I've found this example (Andrew's Excel Tips:Horizontal Filter) which pretty much does what I am asking for, however I cant seem to make it work in my new worksheet when its copied into it. (copied the module and the categories into my new worksheet)

Can anyone help me find the code/procedure I need to change to make it work in my new worksheet?
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

filur1

New Member
Joined
Dec 21, 2013
Messages
7
Here is the code
Option Explicit

Private c As Range
Private rLastCell As Range
Private rHFilterRow As Range
Private i As Long
Private strFilter As String
Private bFilter As Boolean
Private lCalc As Long


Sub SetrHFilterRange()


On Error Resume Next


Application.ScreenUpdating = False


' Get the Last Cell of the Used Range
Set rLastCell = ThisWorkbook.Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell)


' Reset Range "rHFilter" from Cell C2 to last cell in Used Range
ThisWorkbook.Names.Add Name:="rHFilter", RefersTo:= _
"=Sheet1!$C$2:" & rLastCell.Address


For Each rHFilterRow In Range("rHFilter").Rows


With rHFilterRow


With Cells(.Row, 2)
.Value = "-"
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, Formula1:="=""-"""
.FormatConditions(1).Interior.ColorIndex = 44
.Interior.ColorIndex = 22
End With


strFilter = "-"


i = 3


' Get the unique values in each row of rHFilter
' Then make a list with Data Validation
For Each c In .Cells


If Application.CountIf(Range(Cells(.Row, 3), _
Cells(.Row, i)), c.Value) = 1 Then


strFilter = strFilter & "," & c.Value


End If


i = i + 1


Next c


With Cells(.Row, 2).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=strFilter & ",Blank Cells"
.InCellDropdown = True
End With


strFilter = ""


End With


Next rHFilterRow


For i = 1 To 4


Range(Cells(2, 1), rLastCell).Borders(i).LineStyle = xlContinuous


Next i


Application.ScreenUpdating = True


On Error GoTo 0
End Sub


Sub SetrHFilter()


On Error Resume Next


ThisWorkbook.Sheets(1).Columns.Hidden = False


If Application.CountIf(ThisWorkbook.Sheets(1).Columns(2), "-") _
= Range("rHFilter").Rows.Count Then Exit Sub


If rLastCell Is Nothing Then


Set rLastCell = ThisWorkbook.Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell)


End If


' Speed the code up changing the Application settings


With Application
lCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With


FilterRows:


' Hide columns if cells don't match the values in Column B


For Each rHFilterRow In Range("rHFilter").Rows


With rHFilterRow


If Cells(.Row, 2) <> "-" Then


For Each c In Range(Cells(.Row, 3), Cells(.Row, rLastCell.Column))


If Cells(.Row, 2).Value = "Blank Cells" Then


If c.Value <> "" Then c.EntireColumn.Hidden = True


Else


If c.Value <> Cells(.Row, 2).Value Then c.EntireColumn.Hidden = True


End If


Next c


End If


End With


Next rHFilterRow


If bFilter = False Then
bFilter = True
GoTo FilterRows
End If


' Change the Application settings back


With Application
.Calculation = lCalc
.EnableEvents = True
.ScreenUpdating = True
End With


Set rLastCell = Nothing


On Error GoTo 0
End Sub


Sub ResetrHFilter()


On Error Resume Next


ThisWorkbook.Sheets(1).Columns.Hidden = False


SetrHFilterRange


On Error GoTo 0
End Sub
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649
filur1,

Welcome to the MrExcel forum.

What version of Excel and Windows are you using?

I downloaded the example workbook, and, have added it to my archives.

It is interesting, but, the maintenance of the code (especially the data validation cells) would be a difficult on-going adventure. I think that as you add more data horizontally, and, vertically, you will be constantly updating the code.

You should probably re-structure your dataset, and, use Excel's standard data filter.


With that said, can you give us your workbook to examine?

You can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.
 
Last edited:

filur1

New Member
Joined
Dec 21, 2013
Messages
7
I use Excel 2010 on windows.

Unfortunately it contains confidential company information I cannot disclose with this forum. I was having trouble with the reset filter and the data validation. The data validation is actually something I can do without. How can I make a one time data validation to include in the macro instead?
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649

ADVERTISEMENT

filur1,

Unfortunately it contains confidential company information I cannot disclose with this forum.

You can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.


How can I make a one time data validation to include in the macro instead?

Without your actual raw data, I would not be able to assist you.

Click on the Reply to Thread button, and just put the word BUMP in the thread. Then, click on the Post Quick Reply button, and someone else will assist you.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,471
Messages
5,636,501
Members
416,919
Latest member
twc2c

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top