Here's the Visual Basic code I put together that does everything:
Sub SuperFilter()
Application.ScreenUpdating = False
Sheets("Report - Room").Range("A5:J84").ClearContents
Sheets("Filter").Range("A4:i50").ClearContents
Sheets("Master INFO").Range("A1:I36").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Filter").Range("A1:I2"), _
CopyToRange:=Sheets("Filter").Range("A4"), _
Unique:=False
Dim LR As Long, i As Long, n As Long
With Sheets("Filter")
LR = .Range("B" & .Rows.Count).End(xlUp).Row
n = 5
For i = 5 To LR
.Range("B" & i).Copy
Sheets("Report - Room").Activate
Sheets("Report - Room").Range("A" & n & ":" & "A" & n + 3).Select
Sheets("Report - Room").Paste
.Range("C" & i).Copy
Sheets("Report - Room").Activate
Sheets("Report - Room").Range("B" & n & ":" & "B" & n + 3).Select
Sheets("Report - Room").Paste
.Range("C" & i).Copy
Sheets("Report - Room").Activate
Sheets("Report - Room").Range("C" & n & ":" & "C" & n + 3).Select
Sheets("Report - Room").Paste
n = n + 4
Next i
End With
Application.ScreenUpdating = True
End Sub
And a second piece of code..
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$2" Then Call SuperFilter
End Sub
First I designed a standard Advanced Filter Macro.
Advanced Filtering works by comparing a table of data (that has headers) to a set of criteria, which is just a list of those same headers with something below it in the next row. In your case, we want to compare the table to Room Number and Two.
First, I added an extra tab with your table headers at the top. In the row right beneath Room Number I put ='Report - Room'!G2 so that it autopopulates with the value you want to filter against. A1:I2 represents the filter.
Next, I used the following code to look at your raw data, compare it to the Filter criteria I've designed, and then instantly paste it to A4 right below the filter.
This is the heart of every basic advanced filter macro.
Sheets("Master INFO").Range("A1:I36").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Filter").Range("A1:I2"), _
CopyToRange:=Sheets("Filter").Range("A4"), _
Unique:=False
The reason for this, is that its hard to paste the data as it is into merged cells, so this is sort of a baby step in between.
The second half of the code finds where the last row of data is. Now it knows Row 5 to ??? is what it cares about. Now it copies the first cell from column B into A5:A8, which has to be specifically spelled out because of the merged cell. It adds 4 to the row numbers, and pastes the next value into A9:A12 and so on.
It then repeats the same process for each row it found down Column C and then down Column D.
In the beginning of this subroutine, I put Application.Updating = False which tells Excel to stop updating while this is running, otherwise you'd see Excel jump around as it looks at different tabs and pastes into each cell. This is followed by a clear command, which clears your form and filter tab so that you have fresh results every time. At the very end of the whole thing, we tell Excel to turn the ScreenUpdating back on.
The second code block I wrote it a Worksheet Change Event. This type of code goes directly onto a worksheet's VB page. It states that if something I declare changes, to run. In my code, I said if G2 (the dropdown on Report - Rooms) changes, run the Filtering and Pasting macro.
So, now every time you change the dropdown it will run through all of that code all over again.
Bookmarks