Custom KML creator - need help please

jayd4wg

Board Regular
Joined
Mar 25, 2005
Messages
197
I've picked apart a number of KML creation spreadsheets in an effort to help my sales teams in the office by giving them the ability to map out certain customers based on criteria. my "massive" spreadsheet mentioned in an unreplied previous post is the raw output of a report we run against customer files in our CRM.

Now that I have the data, and I have tweaked the KML creator to add what I need as far as output to a custom bubble in Google earth, i was horrified to find that the macro does not just run on VISIBLE rows of data after filtering the results. it maps all 20k of the available lines. Needless to say i'm glad i saved my work before the PC crashed.

This is PARAMOUNT to the success of this mapping utility (being able to only map filtered results)

One way around this obviously would be to filter the data, copy the rows to a new blank workbook, and then run the script against the new report. this is an extra step I think we can work around but I dont' know how.

here's my current code:
Code:
Sub generateKML()
'
'Generate KML Macro


'dim variables
Dim pm_name$, pm_addr$, pm_acctNum$, pm_lat$, pm_lon$, pm_facClass$, pm_parentAcctNum$, pm_revenue$, pm_renewDate$, pm_contactName$, pm_contactNum$, pm_expDate$, pm_term$, pm_autoRenew$, pm_facEqv$
Dim pm_dyIP As Double
Dim cell As Range

'establish filepath and open document for writing

filepath = "C:\MyMap.kml"

Open filepath For Output As #1

'write header to file

Print #1, "<?xml version=""1.0"" encoding=""UTF-8""?>"
Print #1, "<kml xmlns=""http://www.opengis.net/kml/2.2"">"
Print #1, "<Document>"

'loop through rows of data

For Each cell In [Data!a3:a20001]
        pm_name = cell.Offset(0, 6)

'establish values for each row
        pm_dyIP = cell.Offset(0, 60)
        pm_addr = cell.Offset(0, 2) & ", " & cell.Offset(0, 17) & " " & cell.Offset(0, 19) & ", " & cell.Offset(0, 20) & " " & cell.Offset(0, 21)
        pm_acctNum = cell.Offset(0, 5)
        pm_parentAcctNum = cell.Offset(0, 3)
        pm_contactName = cell.Offset(0, 8)
        pm_contactNum = cell.Offset(0, 9)
        pm_contactEmail = cell.Offset(0, 10)
        pm_lat = cell.Offset(0, 86)
        pm_lon = cell.Offset(0, 87)
        pm_facClass = cell.Offset(0, 47)
        pm_facEqv = cell.Offset(0, 48)
        pm_revenue = cell.Offset(0, 50)
        pm_term = cell.Offset(0, 45)
        pm_renewDate = cell.Offset(0, 43)
        pm_expDate = cell.Offset(0, 44)
        pm_autoRenew = cell.Offset(0, 46)
'catch end of document to exit loop
        If pm_name = "" Then
            Exit For
        End If
'write output to text file
        Print #1, "<Placemark>"
        Print #1, "<name>" & pm_name & "</name>"
        Print #1, "<description>"
        Print #1, "<![CDATA["
        Print #1, "<h1>" & pm_name & "</h1>"
        Print #1, "<p><b>Account Number:</b> " & pm_acctNum & "<b>/ Parent: </b>" & pm_parentAcctNum; ""
        Print #1, "<p><b>Contact:</b> " & pm_contactName & " <b>at</b> " & pm_contactNum
        Print #1, "<P>Facility Class = " & pm_facClass & " / " & pm_facEqv
        Print #1, "<br>Total Revenue: " & pm_revenue
        Print #1, "<br>Renewal Date: " & pm_renew
        Print #1, "<br>Expiration Date: " & pm_expDate & " / Auto?= " & pm_autoRenew
        Print #1, "]]>"
        Print #1, "</description>"
        Print #1, "<Point>"
        Print #1, "<coordinates>" & pm_lat & "," & pm_lon & "</coordinates>"
        Print #1, "</Point>"
        Print #1, "</Placemark>"

    Next cell
'write footer to file
Print #1, "</Document>"
Print #1, "</kml>"

Close #1

End Sub

data starts on row 3, and occupies nearly 90 columns of data (all the way over to column CJ)

what do i have to do in order to get the range to fit the filtered results?
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
the print statements above are jacked up because of HTML code in the CDATA tags...ignore those. the output is good...it's just ALLLL the output.
 
Upvote 0
Code:
If cell.EntireRow.Hidden = False Then
endif
this fixed me up nice and tidy. leaving the post in case this comes up again soon...i know it will. I didn't find the fix here but on Ozgrid but that thread referenced another thread here with a completely different way to fix it. the two methods got my wheels turning and i came up with the fix. not the cleanest....but functional.
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,915
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top