skip blank autofiltered table

ysherriff · May 5, 2015

Hi,

I am having an issue with my code. I have a code that filters and copy to a different workbook. If the filtered table has no data, i do not want to copy and move to the next parameter in the range that needs to be filtered.

Here is my code below and I am getting this error message:

Code:

  '----------------- CODE TO COPY TO DRG TAB


  Sheets("DRG Sender to Receiver").Activate
  Set DestCell = TargetSh.Range("DRG_SENDER_RECEIVER_START_CELL")
  Set DestCell = DestCell.Offset(1, 0)
 
  TargetSh.Activate
  Rows("6:" & Rows.Count).ClearContents
 
  For Each MyCell In MyRange
  LastRow = ActiveSheet.Range("B50000").End(xlUp).Row
  If MyCell.Value = "" Then Exit For ' this exits when you have a blank cell
  wkbkGen.Activate
 
  Worksheets("DRG by Sender and Receiver").Activate
 
  '  select the range and autofilter based on hospital name
  Range("a6").Select
  With ActiveSheet
  .AutoFilterMode = False
  .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter
  .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter field:=13, Criteria1:=statename
  .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter field:=6, Criteria1:=MyCell
'  ...................................................................
  On Error Resume Next
  Set tbl = ws.Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").SpecialCells(xlCellTypeVisible)
 
  If tbl.Rows.Count > 1 Then .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter field:=6, Criteria1:=MyCell
'  ...................................................................
  End With
'  ...................................................................
  Set tbl = ws.Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").SpecialCells(xlCellTypeVisible)
  On Error GoTo 0
  If tbl.Rows.Count > 1 Then
'  ...................................................................
  ActiveCell.CurrentRegion.Select
 
  'Set tbl = ActiveCell.CurrentRegion
  tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
  Selection.Copy
 
  'activate template
  wkbkTemp.Activate
 
  TargetSh.Activate
 
  TargetSh.Range(DestCell.Address).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
 
  Set DestCell = TargetSh.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
  End If
  Next MyCell

https://www.dropbox.com/s/912qfod8i8mxp23/Pulmonary%20Selection.zip?dl=0

I have attached the link to the workbook as well. The error is generated below in yellow.

Luke M · May 5, 2015

The line in yellow, change to:

Code:

If Not tbl Is Nothing Then

When you are setting the tbl Range, if there are no visible cells, it will become nothing, so this is how we check for it.

ysherriff · May 5, 2015

Thanks Luke. There is no error but now it just loops and doesn't select the table and then copy it to the other workbook. I will take a stab at it again to see why it is not selecting and then copy. Here is the modified code:

Code:

  '----------------- CODE TO COPY TO DRG TAB
 

  Sheets("DRG Sender to Receiver").Activate
  Set DestCell = TargetSh.Range("DRG_SENDER_RECEIVER_START_CELL")
  Set DestCell = DestCell.Offset(1, 0)
  
  TargetSh.Activate
  Rows("6:" & Rows.Count).ClearContents
  
  For Each MyCell In MyRange
  LastRow = ActiveSheet.Range("B50000").End(xlUp).Row
  If MyCell.Value = "" Then Exit For ' this exits when you have a blank cell
  wkbkGen.Activate
  
  Worksheets("DRG by Sender and Receiver").Activate
  
  '  select the range and autofilter based on hospital name
  Range("a6").Select
  With ActiveSheet
  .AutoFilterMode = False
  .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter
  .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter field:=13, Criteria1:=statename
  .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter field:=6, Criteria1:=MyCell
'  ...................................................................
  On Error Resume Next
  Set tbl = ws.Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").SpecialCells(xlCellTypeVisible)
  
  If Not tbl Is Nothing Then .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter field:=6, Criteria1:=MyCell
'  ...................................................................
  End With
'  ...................................................................
  Set tbl = ws.Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").SpecialCells(xlCellTypeVisible)
  On Error GoTo 0
  If Not tbl Is Nothing Then
'  ...................................................................
  ActiveCell.CurrentRegion.Select
  
  Set tbl = ActiveCell.CurrentRegion
  tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
  Selection.Copy
  
  'activate template
  wkbkTemp.Activate
  
  TargetSh.Activate
  
  TargetSh.Range(DestCell.Address).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  
  Set DestCell = TargetSh.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
  End If
  Next MyCell
  
  Range("B4").Select
  Selection.End(xlDown).Select
  rownum = Selection.Row
  Range("b" & rownum + 1).Select
  Range(Selection, Selection.End(xlDown)).Select
  Selection.EntireRow.Delete
  
  Range("b6").Activate
  
  
  
  'On Error Resume Next
  'Kill folderPathStr & "\*.xls"
  'On Error GoTo 0
  
  ActiveWorkbook.SaveAs OutputFilePath & "\" & reportName
  
  ActiveWorkbook.Close , False
  
  
  
  Next I

Luke M · May 5, 2015

My thoughts on your code, commented with "LUKE M: ..."

Code:

 For Each MyCell In MyRange
      LastRow = ActiveSheet.Range("B50000").End(xlUp).Row
      If MyCell.Value = "" Then Exit For ' this exits when you have a blank cell
     wkbkGen.Activate
     
      Worksheets("DRG by Sender and Receiver").Activate
     
      '  select the range and autofilter based on hospital name
     Range("a6").Select
      With ActiveSheet
          .AutoFilterMode = False
          .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter
          .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter field:=13, Criteria1:=statename
          .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter field:=6, Criteria1:=MyCell
        '  ...................................................................
         On Error Resume Next
          Set tbl = ws.Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").SpecialCells(xlCellTypeVisible)
         
          'LUKE M: Why do we re-filter the table? It's already filtered
          If Not tbl Is Nothing Then .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter field:=6, Criteria1:=MyCell
        '  ...................................................................
     End With
    '  ...................................................................
    'LUKE M: We already defined tbl, shouldn't need to do this again
     Set tbl = ws.Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").SpecialCells(xlCellTypeVisible)
      On Error GoTo 0
      If Not tbl Is Nothing Then
            '  ...................................................................
             'LUKE M: DANGER!! the last cell activated was A6. Is this really the cell you want, or should it be tbl?
             ActiveCell.CurrentRegion.Select
             
              'LUKE M: Again, tbl was already defined, not sure why we're changing it again
              Set tbl = ActiveCell.CurrentRegion
              tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
              Selection.Copy
             
              'activate template
             wkbkTemp.Activate
             
              TargetSh.Activate
             
              TargetSh.Range(DestCell.Address).Select
              Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False
             
              Set DestCell = TargetSh.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
      End If
  Next MyCell

ysherriff · May 6, 2015

Luke,

Thanks for the post. I have tried a couple of things and still not working. It is still selecting the empty table and trying to copy and paste and I get an error message. The error message pixs are attached. I know it is something simple but can't figure it out. Never happened to me before. I appreciate any insight for a novice.

Code:

  '----------------- CODE TO COPY TO DRG TAB
 

  Sheets("DRG Sender to Receiver").Activate
  Set DestCell = TargetSh.Range("DRG_SENDER_RECEIVER_START_CELL")
  Set DestCell = DestCell.Offset(1, 0)
  
  TargetSh.Activate
  Rows("6:" & Rows.Count).ClearContents
  
  For Each MyCell In MyRange
  LastRow = ActiveSheet.Range("B50000").End(xlUp).Row
  If MyCell.Value = "" Then Exit For ' this exits when you have a blank cell
  
  wkbkGen.Activate
  
  Worksheets("DRG by Sender and Receiver").Activate
  
  '  select the range and autofilter based on hospital name
  Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").Select
  With ActiveSheet
  .AutoFilterMode = False
  .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter
  .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter field:=13, Criteria1:=statename
  .Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").AutoFilter field:=6, Criteria1:=MyCell
'  ...................................................................
  On Error Resume Next
  Set tbl = ws.Range("DRG_DISCH_BY_SENDER_RECEIVER_TBL").SpecialCells(xlCellTypeVisible)
  
  End With
'  ...................................................................
  On Error GoTo 0
  If Not tbl Is Nothing Then
'  ...................................................................
  ActiveCell.CurrentRegion.Select

  '---my comments... (I tried not to define the table below but when I deleted the set tbl it did not select the table and therefore ignored the command and continued with the loop )

  Set tbl = ActiveCell.CurrentRegion
  tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
  Selection.Copy
  
  'activate template
  wkbkTemp.Activate
  
  TargetSh.Activate
  
  TargetSh.Range(DestCell.Address).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  
  Set DestCell = TargetSh.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
  End If
  Next MyCell
  
  Range("B4").Select
  Selection.End(xlDown).Select
  rownum = Selection.Row
  Range("b" & rownum + 1).Select
  Range(Selection, Selection.End(xlDown)).Select
  Selection.EntireRow.Delete
  
  Range("b6").Activate
  
  
  
  'On Error Resume Next
  'Kill folderPathStr & "\*.xls"
  'On Error GoTo 0
  
  ActiveWorkbook.SaveAs OutputFilePath & "\" & reportName
  
  ActiveWorkbook.Close , False
  
  
  
  Next I

ysherriff · May 6, 2015

I believe the issue lies in this syntax:

If Not tbl Is Nothing Then

It is always displaying the table as empty so it skips and goes to the next MyCell

Luke M · May 7, 2015

Would it be possible to see your workbook? I'm getting lost as to what's going on. After the filter is applied, it sounded like there were no records found. In which case, tbl is Nothing, and we should go on to the next criteria/MyCell, right?

ysherriff · May 7, 2015

Here you go Luke. Just open up the zip file and the generator is there including all other relevant file and folder path to run the macro appropriately.

https://www.dropbox.com/s/pd64wfx858d4y2j/Pulmonary Selection (2).zip?dl=0

Thanks for you help. I found a around about solution but I rather prefer this method.

ysherriff · May 10, 2015

Luke,

Did you have a chance to look at this? Thanks a million

Luke M · May 11, 2015

Hi ysherriff,

Unfortunately, I can't access files from outside locations (not a problem with your file specifically, problem on my end).

@NARAYANK991 , can you take a look? We're trying to write the code to check if no records are found when table is filtered, but I wasn't able to visualize the layout.

NARAYANK991 · May 12, 2015

Hi ,

I have made some changes in the code , but they are not related to the problem you have mentioned.

The code runs to completion and generates the relevant reports.

I am posting the link to the zipped file , which has been generated after selecting MO in the dropdown in C3 in the Control tab.

Please let me know what I should do to create the error situation , so that I can check it out.

https://www.dropbox.com/s/2efuxy65ci0tz39/Reports.zip?dl=0

Narayan

Luke M · May 12, 2015

Thanks, Narayan.

skip blank autofiltered table

ysherriff

Member

Luke M

Excel Ninja

ysherriff

Member

Luke M

Excel Ninja

ysherriff

Member

ysherriff

Member

Luke M

Excel Ninja

ysherriff

Member

ysherriff

Member

Luke M

Excel Ninja

NARAYANK991

Excel Ninja

Luke M

Excel Ninja