skip blank autofiltered table

[ysherriff]

Hello all, I have a vba code that filters a table based on a list and some items in the list will not show up in the filtered table. How do I go about skipping that item and go to the next item. I know there is a combination of If and Then but don't know the right construct.

The workbook is a lengthy macro workbook that has varied moving parts. I am only pasting the code associated with this issue.

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

  Sheets("DRG").Activate
  Set DestCellDRG = TargetShDRG.Range("DRG_START_CELL")
  Set DestCellDRG = DestCellDRG.Offset(1, 0)
  
  TargetShDRG.Activate
  Rows("2:" & Rows.Count).ClearContents
  
  For Each MyCell In MyRange
  LastRow = ActiveSheet.Range("A700").End(xlUp).Row
  If MyCell.Value = "" Then Exit For ' this exits when you have a blank cell
  
  wkbkGen.Activate
  
  Worksheets("DRG discharges").Activate
  
  'select the range and autofilter based on hospital name
  Range("a6").Select
  With ActiveSheet
  .AutoFilterMode = False
  .Range("DISCH_DRG_TBL").AutoFilter
  .Range("DISCH_DRG_TBL").AutoFilter field:=2, Criteria1:=MyCell
  .Range("DISCH_DRG_TBL").AutoFilter field:=11, Criteria1:=Array( _
  "1", "2", "3", "4", "5"), Operator:=xlFilterValues
  End With

If(tbl.Rows.Count <1)Then

Next MyCell

  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
  
  TargetShDRG.Activate
  
  TargetShDRG.Range(DestCellDRG.Address).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  
  Set DestCellDRG = TargetShDRG.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
 
Else
  Next MyCell

So from the above code. If the MyCell filtered data table is blank, I want it to skip and then move on to the next one. I think the error lies in the code below

If(tbl.Rows.Count <1)Then

Next MyCell

but I do not know how to fix.

let me know if you need the entire source file

 

[NARAYANK991]

Hi ,

I am not sure that this will work , but you can try ; I have demarcated the portions which have been changed ; most of it is unchanged.

  Sheets("DRG").Activate
  Set DestCellDRG = TargetShDRG.Range("DRG_START_CELL")
  Set DestCellDRG = DestCellDRG.Offset(1, 0)
 
  TargetShDRG.Activate
  Rows("2:" & Rows.Count).ClearContents
 
  For Each MyCell In MyRange
      LastRow = ActiveSheet.Range("A700").End(xlUp).Row
      If MyCell.Value = "" Then Exit For ' this exits when you have a blank cell
      wkbkGen.Activate
 
      Worksheets("DRG discharges").Activate
 
  '  select the range and autofilter based on hospital name
      Range("a6").Select
      With ActiveSheet
          .AutoFilterMode = False
          .Range("DISCH_DRG_TBL").AutoFilter
          .Range("DISCH_DRG_TBL").AutoFilter field:=2, Criteria1:=MyCell
'          ...................................................................
          On Error Resume Next
          Set tbl = .Range("DISCH_DRG_TBL").SpecialCells(xlCellTypeVisible)
         
          If Not (tbl Is Nothing) Then .Range("DISCH_DRG_TBL").AutoFilter field:=11, Criteria1:=Array( _
                                    "1", "2", "3", "4", "5"), Operator:=xlFilterValues
'          ...................................................................
      End With
'    ...................................................................
      Set tbl = .Range("DISCH_DRG_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
 
        TargetShDRG.Activate
 
        TargetShDRG.Range(DestCellDRG.Address).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
 
        Set DestCellDRG = TargetShDRG.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
      End If
  Next MyCell

Narayan

 

[ysherriff]

Thank you Naray. You led me in the right direction like always......

 

[ysherriff]

Naryan, I have tried all variations of your solution even changing the IF Not and IS Nothing argument around and playing with it and the data still copies blank data.

I will try again today to see what else I can come up with.

 

[NARAYANK991]

Hi ,

There are some things you can check ; the problem lines are these :

On Error Resume Next
          Set tbl = .Range("DISCH_DRG_TBL").SpecialCells(xlCellTypeVisible)
       
          If Not (tbl Is Nothing) Then .Range("DISCH_DRG_TBL").AutoFilter field:=11, Criteria1:=Array( _
                                    "1", "2", "3", "4", "5"), Operator:=xlFilterValues
'          ...................................................................
    End With
'    ...................................................................
    Set tbl = .Range("DISCH_DRG_TBL").SpecialCells(xlCellTypeVisible)
      On Error GoTo 0
      If Not (tbl Is Nothing) Then

When you do an AutoFilter , the result is Nothing only if the range definition used does not contain the header row.

Thus , when we use the following line of code :

Set tbl = .Range("DISCH_DRG_TBL").SpecialCells(xlCellTypeVisible)

I have no idea of whether the highlighted range includes the header row ; if it does , then the check which follows :

If Not (tbl Is Nothing) Then

will not work ; the correct method would be to use :

If tbl.Rows.Count > 1 Then

If the highlighted range definition does not include the header row , then the check :

If Not (tbl Is Nothing) Then

will work.

Apart from this , there are other issues ; after the check , the code is reassigning tbl to another range , through the following lines :

Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
Selection.Copy

Without the data I have no idea what will be copied ; secondly , I do not know why this reassignment is being done ; logically , what ever is the result of filtering should be copied ; why do something else ?

Probably if you can upload your file with the data and the code in it , this problem can be resolved immediately.

Narayan

 

[ysherriff]

here is the link to the source file. I apologize. the table does contain the header row and I will modify to try If tbl.Rows.Count > 1 Then

as far as the reassignment. it is just an oversight and sloppy work. I will clean up after getting code to work.

thanks Narya

 

[NARAYANK991]

Hi ,

It's going to take some time ; if you want , you can remove public access to the file , since I have already downloaded it.

I have removed the link to it from your post ; in case anyone else wants it , please post here in this thread.

Narayan