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

Hiding and Unhiding Rows with Filter Applied

G

gumbles

New Member
Hello All,


I've got a bit of code that when you click on a button, it inserts a new row below with a unique ID number. There are a series of button down the list as they indicate a new section in the list and a button adds a new row to that section.


The problem I have is that when I apply a filter to this list the code does not add a new row, only changes the ID number.


The solution I'm thinking of would be something like this:


(with filter applied)

button clicked,

undhide rows or remove filter

perform code

hide rows that were hidden or reapply filter

end


not sure if this is possible but thought I would ask.


Regards,


Gumbles
 
Hi gumbles,

Would you mind posting the code that you already have so we can use that as a baseline and don't have to rewrite everything?
 
[pre]
Code: 
Sub insert_row()

Dim Header_Row As Long

'First Row in the Table
Header_Row = ThisWorkbook.Worksheets("Issue_List").Range("IssueTable").Row

'Finds the highest number in the range "ID_RANGE"
ID = Application.WorksheetFunction.Max(Range("ID_RANGE"))

'Stops the screen refreshing during the macro
Application.ScreenUpdating = False
Application.Interactive = False

'Finds where the shape is located and inserts a row below

Dim Ro As Long
With ActiveSheet
Ro = .Shapes(Application.Caller).TopLeftCell.Row
.Cells(1, 1).Offset(Ro).Select

'ListObject.ListRow referes to the table within the worksheet,
'therfore needs to be offset to change the row numbers so they match up with the table
'(Ro - Header_Row + 2) does this.

With ActiveCell
.ListObject.ListRows.Add (Ro - Header_Row + 2)
.Offset(Ro).EntireRow.Hidden = False
End With
End With

'+ 1 to the max ID
Cells(Ro + 1, 2) = ID + 1

'Refreshes the screen
Application.ScreenUpdating = True
Application.Interactive = True
End Sub
[/pre]
 
Instead of wrapping each line with `, just put 1 at beginning and end of entire code block. I've fixed it for you. =)

Now to tackle the problem itself...
 
This seems to work okay on my psuedosetup. Had to guess a little bit at how things were arranged, but it does do the unfilter - code - refilter steps.

[pre]
Code: 
Sub insert_row()

Dim Header_Row As Long
Dim xCell As Range
'First Row in the Table
Header_Row = ThisWorkbook.Worksheets("Issue_List").Range("IssueTable").Row

'Finds the highest number in the range "ID_RANGE"
ID = Application.WorksheetFunction.Max(Range("ID_RANGE"))

'Stops the screen refreshing during the macro
Application.ScreenUpdating = False

'Luke M: Might want to consider not doing this. Prevents you from stopping macro if
'this go awry, and it doesn't reset automatically if you do a hard stop
'Application.Interactive = False

'Finds where the shape is located and inserts a row below

Dim Ro As Long
With ActiveSheet
Ro = .Shapes(Application.Caller).TopLeftCell.Row
'Luke M: Using set range so we don't have to select the cell
Set xCell = .Cells(1, 1).Offset(Ro)

'ListObject.ListRow referes to the table within the worksheet,
'therfore needs to be offset to change the row numbers so they match up with the table
'(Ro - Header_Row + 2) does this.

'===============
'Luke M: Code copied from the following site:
'http://stackoverflow.com/questions/9489126/in-excel-vba-how-do-i-save-restore-a-user-defined-filter
Dim w As ListObject
Dim filterArray()
Dim currentFiltRange As String
Dim col As Integer

Set w = xCell.ListObject

' Capture AutoFilter settings
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
ReDim filterArray(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
filterArray(f, 1) = .Criteria1
If .Operator Then
filterArray(f, 2) = .Operator
filterArray(f, 3) = .Criteria2
End If
End If
End With
Next f
End With
End With

'Remove AutoFilter
w.AutoFilter.ShowAllData
'==============

With xCell
.ListObject.ListRows.Add (Ro - Header_Row + 2)
'Luke M: Not sure what next line is fow...
.Offset(Ro).EntireRow.Hidden = False
End With
End With

'+ 1 to the max ID
Cells(Ro + 1, 2) = ID + 1

'=====================
'Luke M: Rest of copied code
' Restore Filter settings
For col = 1 To UBound(filterArray(), 1)
If Not IsEmpty(filterArray(col, 1)) Then
If filterArray(col, 2) Then
w.Range.AutoFilter Field:=col, _
Criteria1:=filterArray(col, 1), _
Operator:=filterArray(col, 2), _
Criteria2:=filterArray(col, 3)
Else
w.Range.AutoFilter Field:=col, _
Criteria1:=filterArray(col, 1)
End If
End If
Next col
'==================

'Refreshes the screen
Application.ScreenUpdating = True
Application.Interactive = True
End Sub
[/pre]
 
Brilliant. I will try this out.


I did remove the Screen Interaction when I was building the code but since I thought I had finished it I put if back, guess not though ha!


Thanks,


Gumbles
 
Hey Luke,


I'm having some issues with the code.


When I run it, Im getting a debug error that states .Criteria2 is an application-defined or object-defined error, but .Operator works fine. Any Ideas?
 
Hmm. I've revererted back to your original code then, and just spliced the new filtering code where it would work best then. Is this what you have?

[pre]
Code: 
Sub insert_row()

Dim Header_Row As Long

'First Row in the Table
Header_Row = ThisWorkbook.Worksheets("Issue_List").Range("IssueTable").Row

'Finds the highest number in the range "ID_RANGE"
ID = Application.WorksheetFunction.Max(Range("ID_RANGE"))

'Stops the screen refreshing during the macro
Application.ScreenUpdating = False
Application.Interactive = False

'Finds where the shape is located and inserts a row below

'===============
'Luke M: Code copied from the following site:
'http://stackoverflow.com/questions/9489126/in-excel-vba-how-do-i-save-restore-a-user-defined-filter
Dim w As ListObject
Dim filterArray()
Dim currentFiltRange As String
Dim col As Integer

'Needed to know where a cell in your table is at, so picked
'the first row (assumed it's in col A at least)
Set w = Cells(Header_Row, 1).ListObject

' Capture AutoFilter settings
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
ReDim filterArray(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
filterArray(f, 1) = .Criteria1
If .Operator Then
filterArray(f, 2) = .Operator
filterArray(f, 3) = .Criteria2
End If
End If
End With
Next f
End With
End With

'Remove AutoFilter
w.AutoFilter.ShowAllData
'==============

Dim Ro As Long
With ActiveSheet
Ro = .Shapes(Application.Caller).TopLeftCell.Row
.Cells(1, 1).Offset(Ro).Select

'ListObject.ListRow referes to the table within the worksheet,
'therfore needs to be offset to change the row numbers so they match up with the table
'(Ro - Header_Row + 2) does this.

With ActiveCell
.ListObject.ListRows.Add (Ro - Header_Row + 2)
.Offset(Ro).EntireRow.Hidden = False
End With
End With

'+ 1 to the max ID
Cells(Ro + 1, 2) = ID + 1

'=====================
'Luke M: Rest of copied code
' Restore Filter settings
For col = 1 To UBound(filterArray(), 1)
If Not IsEmpty(filterArray(col, 1)) Then
If filterArray(col, 2) Then
w.Range.AutoFilter Field:=col, _
Criteria1:=filterArray(col, 1), _
Operator:=filterArray(col, 2), _
Criteria2:=filterArray(col, 3)
Else
w.Range.AutoFilter Field:=col, _
Criteria1:=filterArray(col, 1)
End If
End If
Next col
'==================

'Refreshes the screen
Application.ScreenUpdating = True
Application.Interactive = True
End Sub
[/pre]
 
Here's a link to the file, so you can see. I've checked it for sensitive information and your all clear.


https://www.dropbox.com/s/9c9si34y9e987bc/ESDID_SQCDP_Test.xlsm
 
Hmm, I'll have to give it a look tonight. I'm afraid I can't access uploaded workbooks from my present location. =(
 
Any luck?


Ive been experimenting with different types of variables but still getting stuck on defining the criteria.
 
My apologies gumbles. I've not had a chance yet to download the file. My "other life" has been keeping me quite busy. =P

I've added this thread to my favorites, so I'll try and look to it soon, or perhaps someone else will come along and help. Sorry for the wait.
 
Hi Gumbles.

I've not been able to duplicate your problem...I think. When I got your file, I did notice that one of the references in the VBE was missing. This was causing code to give a "Compile error: Can't find project or library". I assumed this was because it was something on my end, but perhaps it's on your machine as well? In the VBE, check under Tools - References. Mine had a line saying "MISSING: PDFCreator"


You had a second macro in the same module that appears to be wanting to use this, so I'm not sure if the two are interfering or not.


I did several tests.

1. With no filter, tried clicking on different buttons. No problem.

2. Filterd Status column for 25%. Noticed that you can't click the buttons now. Oops. =P

3. Filtered Status column for only blanks. Button clicking worked.

4. Filtered Status column for blanks and 25%. Button clicking worked.


Can you confirm whether you can duplicate my tests, or if I've missed a step somewhere?
 
Hi Luke,


Cheers for your time.


Ah yes, thats the macro that prints the charts for Display. I got that code from another forum and it used PDF Creator to run and is installed on all the Machines that use it and shouldnt interfere with the first section of code.


I should probably explain how this spreadsheet is designed to be used sorry. I am only using the filters to hide the rows that are at 100% as these issues are completed and dont need to be seen.


To add a new issue you click on the questions in colunn A that have shapes overlaid on them to act as buttons, so in practice you would never filter out anything other than 100%. The reason I need this code is so that when the 100% rows are hidden below a question row (blank row) the macro doesnt function properly and just changes the ID number.


E.g. If you filter out 100% row 10 is now hidden. If you click on A9 then a new row will not be added. Instead row 10's ID number will be updated.


If you try deleting the second piece of code and then filtering out 100% you should be able to duplicate my problem.


Gumbles.
 
Hmm, I see what you mean. =(

Well, we can try forcing the macro to continue. Not best practice, but i'm running out of ideas as to what could be wrong, and the macro as a whole seems to function okay if we skip that line. Starting at line 40 of the macro.

[pre]
Code: 
change this:
filterArray(f, 2) = .Operator
filterArray(f, 3) = .Criteria2

to this
'Added in case AutoFilter reads incorrectly
On Error Resume Next
filterArray(f, 2) = .Operator
filterArray(f, 3) = .Criteria2
On Error GoTo 0
[/pre]
 
Wooo!


That seems to have done the trick. Thank you.


Sorry to be a pain, but could you explain why the "On Error" code is bad practice because Ive heard that before from other coders, but never understood why...


Regards,


Gumbles.
 
It's literally telling the code that if an error comes up, to just keep going. It's bad practice in this case because we don't really know why there's an error, so it's possible an legitimate error could pop up, but we still ignore it. A "good" use of that line is, let's say you want to select all the constants, *if* there are any. You could so something like

[pre]
Code: 
On error resume Next
Range("A:A").SpecialCells(xlConstants)[/pre]
That way, in case there are no constants, the code doesn't get mad and still goes on.


Now, for our case, what's the worst that will happen? Not too much. We might not get the exact same filter settings applied, but the overall tool continues to work. Note that the

On Error GoTo 0

is there to reset the program. Since there is no 0 line, this tells the code that if an error arises, Let us know!


Does that make sense? In short, you're telling the code to keep going no matter what, which can be a risky move.


PS. This is my 4000th post. Woot woot! =)
 
You must log in or register to reply here.
Back
Top