VBA Filter for Columns instead of Rows

Dude never responds

Nice, but pretty useless for viewers if you don't share the sub code ! :(

'PART 1 MODULO CODE

Sub FillFilters() 'with sortcut
Dim oRange As Range, l As Long, r As Long, c As Long, sFilter As String, arr As Variant, sTemp As String, bDone As Boolean
If Range("A1") = "Filters" Then Exit Sub
Range("A2").EntireColumn.Insert
Set oRange = Sheet9.Range("A2").CurrentRegion
With oRange
.Cells.EntireColumn.Hidden = False
.Cells(1, 1) = "Filters"
For r = 2 To .Rows.Count
For c = 3 To .Columns.Count
If WorksheetFunction.CountIf(Range(Cells(r, 3), Cells(r, c)), Cell(r, c)) = 1 Then
sFilter = sFilter & "," & Cells(r, c)
End If
Next c
arr = Split(sFilter, ",")
Do
bDone = True
For I = 1 To UBound(arr) - 1
If arr(I) > arr(I + 1) Then
bDone = False: sTemp = arr(I): arr(I) = arrr(I + 1): arr(I + 1) = sTemp
End If
Next I
Loop While bDonw = False
sFilter = Join(arr, ",")
With .Cells(r, I).Validation
.Delete
.Add Type:=xiValidateList, Formula1:="-" & sFilter & ",Blanks"
.InCellDropdown = True
End With
sFilter = ""
Next r
.Cells.EntireColumn.Hidden = False
End With


End Sub

Sub DeleteFilters() 'with shortcut
If Range("A1") = "Filters" Then
Cells.EntireColumn.Hidden = False
Range("A1").EntireColumn.Delete
Range("A1").Select
End If

End Sub

Sub Filtering(oFIlter As Range)
Dim oRange As Range, sCell As String, r As Long, c As Long, iRow As Long, iCount As Long
Set oRange = Sheet5.Range("A2").CurrentRegion
sCell = oFIlter.Value
If sCell = "Filters" Then oRange.Cells.EntireColumn.Hidden = False: Exit Sub
If sCell = "" Then oRange.Cells.EntireColumn.Hidden = False: Exit Sub
If sCell = "-" Then oRange.Cells.EntireColumn.Hidden = False: Exit Sub
If sCell = "Blanks" Then oRange.Cells.EntireColumn.Hidden = False: sCell = ""
oRange.Cells.EntireColmn.Hidden = False
iRow = oFIlter.Row
With oRange
For c = 3 To .Columns.Count
If .Cells(iRow, c) <> sCell Then
.Cell(iRow, c).EntireColumn.Hidden = True
Else
iCount = iCount + 1
End If
Next c
MsgBox iCount & " columns for row " & iRow
End With





End Sub

Thanks Dr Gerard, This is really cool!

we have a query can i change column data to another column data after using autofilter in vba

Anybody wrote the code manually ? Would like to have it :)

========================
MODULE CODE
========================
Option Explicit
Sub FillFifters() 'with shortcut
Dim oRange As Range, i As Long, r As Long, c As Long, sFilter As String, arr As Variant, sTemp As String, bDone As Boolean
If Range("A1") = "Filters" Then Exit Sub
Range("A2").EntireColumn.Insert
Set oRange = Sheet11.Range("A2").CurrentRegion
With oRange
.Cells.EntireColumn.Hidden = False
.Cells(1, 1) = "Filters"
For r = 2 To .Rows.Count
For c = 3 To .Columns.Count
If WorksheetFunction.CountIf(Range(Cells(r, 3), Cells(r, c)), Cells(r, c)) = 1 Then
sFilter = sFilter & "," & Cells(r, c)
End If
Next c
arr = Split(sFilter, ",")
Do
bDone = True
For i = 1 To UBound(arr) - 1
If arr(i) > arr(i + 1) Then
bDone = False: sTemp = arr(i): arr(i) = arr(i + 1): arr(i + 1) = sTemp
End If
Next i
Loop While bDone = False
sFilter = Join(arr, ",")
With .Cells(r, 1).Validation
.Delete
.Add Type:=xlValidateList, Formula1:="-" & sFilter & ", Blanks"
.InCellDropdown = True
End With
sFilter = ""
Next r
.Cells.EntireColumn.Hidden = False
End With
End Sub
Sub DeleteFilters() 'with shortcut
If Range("A1") = "Filters" Then
Cell.EntireColumn.Hidden = False
Range("A1").EntireColumn.Delete
Range("A1").Select
End If
End Sub
Sub Filtering(oFilter As Range) 'in worksheet event
Dim oRange As Range, sCell As String, r As Long, c As Long, iRow As Long, iCount As Long
Set oRange = Sheet11.Range("A2").CurrentRegion
sCell = oFilter.Value
If sCell = "Filters" Then oRange.Cells.EntireColumn.Hidden = False: Exit Sub
If sCell = "" Then oRange.Cells.EntireColumn.Hidden = False: Exit Sub
If sCell = "-" Then oRange.Cells.EntireColumn.Hidden = False: Exit Sub
If sCell = "Blanks" Then oRange.Cells.EntireColumn.Hidden = False: sCell = ""
oRange.Cells.EntireColumn.Hidden = False
iRow = oFilter.Row
With oRange
For c = 3 To .Columns.Count
If .Cells(iRow, c) <> sCell Then
.Cells(iRow, c).EntireColumn.Hidden = True
Else
iCount = iCount + 1
End If
Next c
MsgBox iCount & " columns for row " & iRow
End With
End Sub


====================
SHEET1 CODE
====================
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A1") <> "Filters" Then Exit Sub
If Target Is Nothing Then Exit Sub
If Target.Column = 1 Then Filtering Target
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1") <> "Filters" Then Exit Sub
If Target Is Nothing Then Exit Sub
If Target.Column <> 1 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
Filtering Target
End Sub

When i press ctrl+shift+F it opens fonts.... Am i doing something wrong?

Excellent video, not only to do the filtering but to learn how to do the VBA programming. do you have VBA tutorials in this way... would be great

WIsh the code was pated here. Typing this in by hand will bring me back to the mid 80's typing in code for my VIC-20 from the back of a magazine.


If I do it, I'll paste the code here since I like the way this seems to work.

Nice tip, anyone ever get code for this?? - it seems the author is oblivions to comments and the concept of sharing via pastebin, etc.

Is there a way to give the possibility to select multiple values to filter on for a row (ex. I want to show all the values that are equal to 2 and 3 in a row)?

Very Helpful video, Can you please share the code as well.

Thanks. That was really helpful.

Hi, this is a very interesting video. Can you please share the module code. Thanks

Hi is it possible to make the filter selective for one row? So that I can filter different Columns for example all columns in that row, that have 30 and 44 and 60 (And so on) in it? would be really great! thank you!

Hi I have code it as per your instruction, but the dropbox do not appear on my spread sheet. Can you help advise?

Can i have the code please...