How to read the values for the entire column till the end?

[Mangolili]

For some reason, this is not reading the entire column to till the end? is there any way to fix it? Or anyone can explain why? Please help, thanks.

For i = 1 To intColCount
With .Item(i)
If .On Then
filterArray(i, 1) = .Criteria1
If .Operator Then
MsgBox "Only one filter per column please."
Exit Sub
End If
' debug
' MsgBox filterArray(i, 1)
End If
End With
Next i

intColCount = .Count



For i = 1 To intColCount
If filterArray(i, 1) <> "" Then

WS.Range(Cells(1, i).Address & ":" & _
Cells(1, i).End(xlDown).Address).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Value").Range("A1"), Unique:=True

 

[JackDanIce]

You don't specify how IntColCount is calculated; may help posting more of your code.

Or you could try incorporating one of these:

IntColCount = Range("A" & Rows.Count).End(xlUp).Row

IntColCount = Cells(Rows.Count, 1).End(xlUp).Row

Adjust as you need
And I think this part of your code:

WS.Range(Cells(1, i).Address & ":" & _
Cells(1, i).End(xlDown).Address).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Value").Range("A1"), Unique:=True

Could be changed to:

WS.Range("A" & i & ":A" & Range("A" & i).End(xlDown).Row).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Value").Range("A1"), Unique:=True

Generally, it's easier to read code if you keep consistent between using Range or Cells but not mixing.. or just my own preference!

 

[Mangolili]

Thanks for the reply, here is more code. It will be great if you look into it for me. Thank you.


'Capture AutoFilter settings
With WS.AutoFilter
currentFiltRange = .Range.Address
With .Filters
' don't need operator or criteria2, so just 1 is enough
' ReDim filterArray(1 To .Count, 3)
intColCount = .Count
ReDim filterArray(1 To intColCount, 1)

For i = 1 To intColCount
With .Item(i)
If .On Then
filterArray(i, 1) = .Criteria1
If .Operator Then
MsgBox "Only one filter per column please."
Exit Sub
End If
' debug
' MsgBox filterArray(i, 1)
End If
End With
Next i

intColCount = .Count

For i = 1 To intColCount
If filterArray(i, 1) <> "" Then
'Paste distinct column values onto Values tab
WS.Range(Cells(1, i).Address & ":" & _
Cells(1, i).End(xlDown).Address).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Value").Range("A1"), Unique:=True
End If
Next i

' This Sub reads the filters from "Value" sheet and store them in
' availableFilters array and deletes the sheet "Value"
ReadAvailableFilters


For i = 1 To intColCount
If filterArray(i, 1) <> "" Then
'Assign new filter value
'loop through the distinct value array
'find where filterarray = value array
'assign next value to column
For x = 1 To UBound(availableFilters)
If availableFilters(x) = Replace(filterArray(i, 1), "=", "") Then
Range(currentFiltRange).AutoFilter field:=i, Criteria1:=availableFilters(x + 1)
End If
Next
End If
Next


End With
End With


End Sub