Day 196

Morelia, Mexico

I spent 2 days messing about with my maps, getting them linked to my blog posts, and its been a minor nightmare. Its not good to have to edit them manually so I’ve been working on automating the whole process through macros. After much effort I finally succeeded and so now I only have to press a few buttons and its mostly sorted out.

So, in case anyone is interested, here is the code. I will do a better post sometime in the future. Maybe. The results should be apparent in a few hours…

Sub Macro1()
‘
‘ Macro1 Macro
‘ Macro recorded 1/19/2008 by Travel Trousers
‘
‘ Keyboard Shortcut: Ctrl+q
‘
‘initial cut to 10kmh subroutine
‘Application.ScreenUpdating = False
‘delete first row
Range(”A1″).Select
ActiveCell.EntireRow.Delete
Range(”A2″).Select
Do

If ActiveCell.Offset(0, 5).Value < 10 Then

ActiveCell.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select

End If

ActiveCell.Offset(1, 0).Select

Loop Until IsEmpty(ActiveCell.Offset(1, 0))
‘delete last row
ActiveCell.Offset(0, 0).EntireRow.Delete

Application.ScreenUpdating = True

‘delete unneeded time and distance columns
Columns(”E:F”).Delete

End Sub

Sub Macro2()
‘
‘ Macro2 Macro
‘ Macro recorded 1/19/2008 by Travel Trousers
‘
‘ Keyboard Shortcut: Ctrl+w
‘
’second macro to halve the output each time it runs

Range(”A2″).Select
‘Application.ScreenUpdating = False
Do
ActiveCell.EntireRow.Delete
ActiveCell.Offset(1, 0).Select
‘ActiveCell.EntireRow.Select
‘ActiveCell.EntireRow.Clear

Loop Until IsEmpty(ActiveCell.Offset(1, 0))

Application.ScreenUpdating = True

End Sub

Sub Macro3()
‘
‘ Macro3 Macro
‘
‘ Keyboard Shortcut: Ctrl+Shift+E
‘
‘make sure we can see the date
Columns(”D:D”).Select
Selection.ColumnWidth = 20

Dim startdate As Date
Dim datenow As Date
Dim days As String

Dim blogtitle As String
Dim blogpage As String
Dim blogloc As String
Dim currcell As String

‘define start of trip
startdate = “13/09/2007″

’start at row 3
Range(”A3″).Select
Application.ScreenUpdating = False
Do
‘check if the dates change
If ActiveCell.Offset(0, 3).Value <> ActiveCell.Offset(1, 3) Then
’select the row under &
ActiveCell.Offset(1, 0).Select
‘make a new line for kml info
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
‘remember active cell
currcell = ActiveCell.Row
‘copy the date now
datenow = ActiveCell.Offset(-1, 3).Value

Range(”K1″).Select
blogtitle = ” No blog entry for this day”
blogpage = “”
blogloc = “”

‘work out the date and then pull the info from the list of points from the K column
Do
If ActiveCell.Offset(0, 1).Value = datenow Then
blogpage = “http://www.traveltrousers.com/blog/?p=” + ActiveCell.Offset(0, 0).Text
blogtitle = ActiveCell.Offset(0, 2)
blogtitle = “<![CDATA[<p><A href=" + Chr$(34) + blogpage + Chr$(34) + ">" + blogtitle + "</A>]]>”
blogloc = ActiveCell.Offset(0, 3)
‘info found so exit loop
Exit Do

End If
‘move down to continue loop
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Offset(0, 0) = “END”

’start back at the top
Range(”a1″).Select
‘& go back to previous cell

ActiveCell.Offset(currcell - 1, 0).Select
‘work out how many days have passed
days = Application.WorksheetFunction.Days360(startdate, datenow)
‘fill out the cell with the info
ActiveCell.Offset(0, 0).Value = “</coordinates></LineString></Placemark><Placemark><name>Day ” + days + “</name><description>” + ActiveCell.Offset(-1, 3).Text + blogtitle + “</description><styleUrl>#msn_ylw-pushpin</styleUrl><Point><coordinates>” + ActiveCell.Offset(-1, 0).Text + “,” + ActiveCell.Offset(-1, 1).Text + “,” + ActiveCell.Offset(-1, 2).Text + “</coordinates></Point></Placemark><Placemark><name>” + blogloc + “</name><description>” + ActiveCell.Offset(-1, 3).Text + blogtitle + “</description><styleUrl>#sn_ylw-pushpin</styleUrl><LineString><coordinates>”

‘move on if succesful
ActiveCell.Offset(1, 0).Select
End If
‘move down to continue loop
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(1, 0))
‘delete the unneeded columns
Columns(”D:N”).Delete

End Sub



You might also want to read....