CODEWITHSUNDEEP
vbaexcel
Jonathan
Jonathan

Reputation: 315

VBA, Advanced Filter not working w/ Blank Sheets

I got the following macro, but when I run it for some files with just headers and nothing beneath, I get a error obviously, because I altered it to not include headers.

Is there any workaround to perhaps populate a 'N/A' instead of getting this error? Any codes I could use to put N/A in certain columns where they are blank throughout a workbook? or any ideas?

    Sub GetUniqueValues()




Dim wks As Excel.Worksheet
Dim wksSummary As Excel.Worksheet
'----------------------------------------------------------------------------------
'edited so it shows in the 3rd column row +1.  Add the header and sheet name macro to this

On Error Resume Next
Set wksSummary = Excel.ActiveWorkbook.Worksheets("Unique data")
On Error GoTo 0

If wksSummary Is Nothing Then
    Set wksSummary = Excel.ActiveWorkbook.Worksheets.Add
    wksSummary.Name = "Unique data"
End If


'Iterate through all the worksheets, but skip [Summary] worksheet.
For Each wks In Excel.ActiveWorkbook.Worksheets

    With wksSummary

        If wks.Name <> .Name Then
            If Application.WorksheetFunction.CountA(wks.Range("C:C")) Then
                Dim r As Range

    ' Get the first cell of our destination range...
  Set r = .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row + 1, 3)

  ' Perform the unique copy...
   wks.Range("C:C").AdvancedFilter xlFilterCopy, , r, True

   ' Remove the first cell at the destination range...
    r.Delete xlShiftUp
            End If
        End If

    End With

Next wks


'Headers
Range("A1").Value = "File Name "
Range("B1").Value = "Sheet Name "
Range("C1").Value = "Column Name"

      Dim intRow As Long: intRow = 2

     For i = 1 To Sheets.Count
If Sheets(i).Name <> ActiveSheet.Name Then
    Cells(intRow, 2) = Sheets(i).Name
    Cells(intRow, 1) = ActiveWorkbook.Name
    intRow = intRow + 1
End If
   Next i




   End Sub

Upvotes: 0

Views: 434

Answers (1)

SierraOscar
SierraOscar

Reputation: 17637

Replace 

wks.Range("C:C").AdvancedFilter xlFilterCopy, , r, True

with:

If WorksheetFunction.CountA(wks.Range("C:C")) > 1 Then
    wks.Range("C:C").AdvancedFilter xlFilterCopy, , r, True
End If

Upvotes: 1

Related Questions