If Statement in VBA Code and if conditions dont apply continue with next VBA call

[ShuStar]

Hi all,

Hoping someone can help me crack the below logic that is to be applied to the below.

Essentially this code is scanning 3 columns and when it is going into a column it is filtering by anything not equal to #N/A. It then copies anything it finds and pastes it into another tab and then jumps into the next column and repeats this.

The bit I am stuck on - is that I didn't factor in what it should do if it filtered by not equal to #N/A and the filter came up as blank (ie no results or blank cell with nothing to copy). VBA throws an error when it gets this scenario.

Therefore, upon this instance, I would need the code to just jump onto the next column and do the check there and then the final column. If for any reason all 3 columns came up blank, then it should just clear the filters and move onto my next "Call method" as part of my overall VBA code module.

Seems like an IF Logic needs to be applied or some sort of Error Handling piece to add - but that's where I'm stuck!!

As always - many thanks in advance for your help Gurus!

My code:

Sub test1()



Sheets("Test Sheet").Select
Range("B17").AutoFilter Field:=2, Criteria1:="<>#N/A"
'-- If below is not true then skip to C17 otherwise continue with the copy
Range("B18:B300").SpecialCells(xlCellTypeVisible).Copy
Sheets("List").Select
Range("T3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
Sheets("Test Sheet").Select
Sheets("Test Sheet").ShowAllData



Range("C17").AutoFilter Field:=3, Criteria1:="<>#N/A"
'-- If below is not true then skip to D17 otherwise continue with the copy
Range("C18:C300").SpecialCells(xlCellTypeVisible).Copy
Sheets("List").Select
Range("T3").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
Sheets("Test Sheet").Select
Sheets("Test Sheet").ShowAllData

Range("D17").AutoFilter Field:=4, Criteria1:="<>#N/A"
'-- If below is not true then skip to take the action on the last comment noted at the end
Range("D18:D300").SpecialCells(xlCellTypeVisible).Copy
Sheets("List").Select
Range("T3").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
Sheets("Test Sheet").Select
Sheets("Test Sheet").ShowAllData

'-- If all 3 filters come up as blank, then skip this Sub() and continue with the outlined Call Method/Macros as part of the wider overall VBA code.


End Sub

 

[Dermot]

You can trap errors like this

On Error Resume Next
Range("B17").AutoFilter Field:=2, Criteria1:="<>#N/A" 
If Err.Number<>0 Then
  'skip to next column
Endif
On Error Resume Next
'carry on as usual

By the way, you can simplify your code a bit. Once you've copied the cells, you can simply write

Sheets("List").Range("T3").PasteSpecial xlPasteValues

 

[DanteAmor]

Here another macro with different aproch for you to consider:

Sub Copy_No_NA()
  Dim i As Long, j As Long, k As Long
  Dim a As Variant, b As Variant
 
  a = Sheets("Test Sheet").Range("B18:D" & Sheets("Test Sheet").Range("B:D").Find("*", , , 2, 1, 2).Row).Value
  ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 1)
  For j = 1 To UBound(a, 2)
    For i = 1 To UBound(a, 1)
      If Not IsError(a(i, j)) Then
        k = k + 1
        b(k, 1) = a(i, j)
      End If
    Next
  Next
 
  If k > 0 Then Sheets("List").Range("T3").Resize(k).Value = b
  '
  'Here you continue with your next macro.
  '
End Sub

 

[ShuStar]

Thank you both, have gone with Dante approach as it minimizes me to use error handling - always confuses me that, however, Dermot - thanks for showing me how to simplify my code - I've got similar style code in my main macro, I've applied that simplification there so thanks for that, very handy to know.

Dante - are you ok to explain your code to me line by line please - it does what i need it to, i just dont understand how/what it is doing. I reckon I could use this approach for other macros I may need to build if I can get my head round how its working.

Once again - thank you both for your support, appreciate it.

 

[DanteAmor]

Dante - are you ok to explain your code to me line by line please

Of course, nothing would please me more than helping you.

Sub Copy_No_NA()
  Dim i As Long, j As Long, k As Long
  Dim a As Variant, b As Variant
  
  'Stores in array 'a' the range of cells from B18:D to the last row with data in the range B:D
  a = Sheets("Test Sheet").Range("B18:D" & Sheets("Test Sheet").Range("C:D").Find("*", , , 2, 1, 2).Row).Value
  
  'Resize array 'b', which will receive data that meets the criteria
  'It starts at 1 and goes up to the number of possible data,
  'which is multiplying the number of rows in array 'a' (a,1) by the number of columns in array 'a' (a,2)
  ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 1)
  
  'starts cycle from 1 to the number of columns in array 'a'
  For j = 1 To UBound(a, 2)
    
    'starts cycle from 1 to the number of rows in array 'a'
    For i = 1 To UBound(a, 1)
    
      'if the data is not error
      If Not IsError(a(i, j)) Then
        
        'increment variable k by 1
        k = k + 1
        'stores in array 'b' in row (incremented) and in column 1 the data from array 'a' in row i and column j
        b(k, 1) = a(i, j)
      End If
    Next
  Next
  
  'Generate the output starting at T3 and resize according to the number of rows increased in variable k
  If k > 0 Then
    Sheets("List").Range("T3").Resize(k).Value = b
    '
    'Here you continue with your next macro.
    '
  End If
End Sub

 

[ShuStar]

Brilliant! Thanks for this, has made it alot clear!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.