Excel VBA Macro - Looping through a column of a filtered table - vba

Question

I have a spreadsheet with a whole bunch of data (A directory of weather stations) which calculates the closest weather stations to a user entered Latitude and Longitude. This worksheet achieves this by calculating distance from the entered point, ranking those distances using SMALL() and then an excel TABLE/List with formulas perform Index(Match()) type calculations using Rankings (1 is closest, 2 is 2nd closest etc).
The worksheet whilst slow, works fairly well - and the excel Tables allow for advanced sorting of the weather station directory by various criteria (Such as length of record in years etc).
I have a VBA Macro that I was writing which used to work, but stopped working when I tried to fix it (awesome).
The purpose of the VBA Macro is to write a Google Earth KML file with the lat/long/weather station name and then to launch that file into google earth so the user can visualise the proximate stations around a set site location (the one previously entered by the user).
Unfortunately the original method I used couldn't handle the Filtered Results of the List, such that if the user filtered the results (Such that the first 4 weather stations were filtered out as an example) the macro would still write the first four weather stations that were not Visible/Were Filtered.
The problem for me is made more difficult as I wish to have only one macro for four worksheets with filter-able tables - for different data types.
At this stage the data the macro needs are stored in the Tables in identically named Table Columns: {"STATION","LONGITUDE","LATITUDE"} in different worksheets. The majority of the KML strings required to write to the KML file are stored in another hidden worksheet "KML".
The macro is launched via a button on each of these pages.
I understand that there could be a solution using ".SpecialCells(xlCellTypeVisible)" - and I've tried extensively to get it to work with my Tables - but have had no luck so far - probably due to my lack of formal training.
Any help appreciated, be it a solution or a suggestion! Apologies for my bad code, the problem loop & broken code area is about halfway down - after 'Find all table on active sheet:
Sub KML_writer()
Dim FileName As String
Dim StrA As String
Dim NumberOfKMLs
Dim MsgBoxResponse
Dim MsgBoxTitle
Dim MsgBoxPrompt
Dim WhileCounter
Dim oSh As Worksheet
Set oSh = ActiveSheet
'Prompt the Number of Stations to Write to the KML File
NumberOfKMLs = InputBox(Prompt:="Please Enter the number of Weather Stations to generate within the Google Earth KML file", _
Title:="Number of Weather Stations", Default:="10")
'Prompt a File Name
FileName = InputBox(Prompt:="Please Enter a name for your KML File.", _
Title:="Lat Long to KML Converter", Default:="ENTER FILE NAME")
'Will clean this up to not require Write to Cell and Write to KML duplication later
Sheets("kml").Range("B3").Value = FileName
Sheets("mrg").Range("C5").Value = "Exported from EXCEL by AJK's MRG Function"
saveDir = "H:\" 'Local Drive available for all users of macro
targetfile = saveDir & FileName & ".KML"
'Write Site Location to KML STRING - user entered values from SITE LOCATION worksheet
StrA = Sheets("kml").Range("B1").Value & Sheets("kml").Range("B2").Value & "SITE LOCATION" & Sheets("kml").Range("B4").Value & Sheets("INPUT COORDINATES").Range("E5").Value & Sheets("kml").Range("B6").Value & Sheets("INPUT COORDINATES").Range("E4").Value & Sheets("kml").Range("B8").Value
'Find all tables on active sheet
Dim oLo As ListObject
For Each oLo In oSh.ListObjects
'
Dim lo As Excel.ListObject
Dim lr As Excel.ListRow
Set lo = oSh.ListObjects(oLo.Name)
Dim cl As Range, rng As Range
Set rng = Range(lo.ListRows(1)) 'this is where it breaks currently
For Each cl In rng2 '.SpecialCells(xlCellTypeVisible)
'Stop looping when NumberofKMLs is written to KML
WhileCounter = 0
Do Until WhileCounter > (NumberOfKMLs - 1)
WhileCounter = WhileCounter + 1
Dim St
Dim La
Dim Lon
'Store the lr.Range'th station data to write to the KML
St = Intersect(lr.Range, lo.ListColumns("STATION").Range).Value
La = Intersect(lr.Range, lo.ListColumns("LATITUDE").Range).Value
Lon = Intersect(lr.Range, lo.ListColumns("LONGITUDE").Range).Value
'Write St La Long & KML Strings for Chosen Stations
StrA = StrA & Sheets("kml").Range("B2").Value & St & Sheets("kml").Range("B4").Value & Lon & Sheets("kml").Range("B6").Value & La & Sheets("kml").Range("B8").Value
Loop
Next
Next
'Write end of KML strings to KML File
StrA = StrA & Sheets("kml").Range("B9").Value
'Open, write, close KML file
Open targetfile For Output As #1
Print #1, StrA
Close #1
'Message Box for prompting the launch of the KML file
MsgBoxTitle = ("Launch KML?")
MsgBoxPrompt = "Would you like to launch the KML File saved at " & targetfile & "?" & vbCrLf & vbCrLf & "Selecting 'No' will not prevent the file from being written."
MsgBoxResponse = MsgBox(MsgBoxPrompt, vbYesNo, MsgBoxTitle)
If MsgBoxResponse = 6 Then ThisWorkbook.FollowHyperlink targetfile
End Sub

Answer 1

Here is an example of iteration over a filtered table. This uses a ListObject table which are a little easier to work with than just a range of autofiltered cells arranged like a table, but the same general idea can be used (except you can't call on the DataBodyRange of a non-ListObject table).
Create a table:
Apply some filter(s) to it:
Notice that several rows have been hidden, and the visible rows are not necessarily contiguous, so we need to use the .Areas of the table's DataBodyRange which are visible.
As you've already surmised, you can use the .SpecialCells(xlCellTypeVisible) to do this.
Here's an example:
Sub TestFilteredTable()
Dim tbl As ListObject
Dim rngTable As Range
Dim rngArea As Range
Dim rngRow As Range
Set tbl = ActiveSheet.ListObjects(1)
Set rngTable = tbl.DataBodyRange.SpecialCells(xlCellTypeVisible)
' Here is the address of the table, filtered:
Debug.Print "Filtered table: " & rngTable.Address
'# Here is how you can iterate over all
' the areas in this filtered table:
For Each rngArea In rngTable.Areas
Debug.Print " Area: " & rngArea.Address
'# You will then have to iterate over the
' rows in every respective area
For Each rngRow In rngArea.Rows
Debug.Print " Row: " & rngRow.Address
Next
Next
End Sub
Sample output:
Filtered table: $A$2:$G$2,$A$4:$G$4,$A$6:$G$6,$A$9:$G$10
Area: $A$2:$G$2
Row: $A$2:$G$2
Area: $A$4:$G$4
Row: $A$4:$G$4
Area: $A$6:$G$6
Row: $A$6:$G$6
Area: $A$9:$G$10
Row: $A$9:$G$9
Row: $A$10:$G$10
Try and adapt this method to your problem, and if you have a specific error/issue with implementing it, let me know.
Just remember to update your original question to indicate a more specific problem :)

Answer 2

I had to find a record in a filtered data and change one value
Sample data
I wanted to change sales personcode to customer C00005.
First i filtered and found customer to modify.
codcliente = "C00005"
enter 'make sure that this customer exist in the checked range
Set test = CheckRng.Find(What:=codcliente, LookIn:=xlValues, LookAt:=xlWhole)
If test Is Nothing Then
MsgBox ("Does not exist customer """ & codcliente & """ !")
DataSheet.AutoFilterMode = False
Else 'Customer Exists
With DataRng 'filter the customer
.AutoFilter Field:=1, Criteria1:=codcliente
End With
Set customer = DataRng.SpecialCells(xlCellTypeVisible) ´Get customer data. It is visible
customer.Cells(1, 6).Value = "NN" 'navigate to 6th column and change code
End If
enter image description here