VBA Macro to Export Data from Excel Spreadsheet to CSV

Resources: http://stackoverflow.com/questions/13496686/how-to-save-semi-colon-delimited-csv-file-using-vba
and: http://stackoverflow.com/questions/35655426/excel-vba-finding-recording-user-selection

Sub Export_CSV()

    '***************************************************************************************
    'author:    kay cichini
    'date:      26102014
    'update:    16122016
    'purpose:   export current spreadsheet to csv.file to the same file path as source file
    '
    ' !!NOTE!!  files with same name and path will be overwritten
    '***************************************************************************************
  
    Dim MyPath As String
    Dim MyFileName As String
    Dim WB1 As Workbook, WB2 As Workbook
    
    Set WB1 = ActiveWorkbook

    '(1) either used range in active sheet..
    'ActiveWorkbook.ActiveSheet.UsedRange.Copy
    
    '(2) or alternatively, user selected input range:
    Dim rng As Range
    Set rng = Application.InputBox("select cell range with changes", "Cells to be copied", Default:="Select Cell Range", Type:=8)
    Application.ScreenUpdating = False
    rng.Copy

    Set WB2 = Application.Workbooks.Add(1)
    WB2.Sheets(1).Range("A1").PasteSpecial xlPasteValues
    
    MyFileName = "CSV_Export_" & Format(Date, "ddmmyyyy")
    FullPath = WB1.Path & "\" & MyFileName
    
    Application.DisplayAlerts = False
    If MsgBox("Data copied to " & WB1.Path & "\" & MyFileName & vbCrLf & _
    "Warning: Files in directory with same name will be overwritten!!", vbQuestion + vbYesNo) <> vbYes Then
        Exit Sub
    End If
    
    If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
    With WB2
        .SaveAs Filename:=FullPath, FileFormat:=xlCSV, CreateBackup:=False
        .Close False
    End With
    Application.DisplayAlerts = True
End Sub

Collect GPX-Files from Subdirectories and Convert to Single KML File

Reference: https://cran.r-project.org/web/packages/sp/vignettes/intro_sp.pdf

library(sp)
library(rgdal)

# here, m ygpx files reside in subdirectories..
setwd("D:/WEB/gardaweb")

files <- dir(pattern="*.gpx$", recursive = T, include.dirs = T)

# extract spatial lines
spl <- lapply(files, function(x) {readOGR(x, "tracks")@lines[[1]]} )
str(spl)

# apply ID to ID slot for latter merge with attribute data
for(i in 1:length(spl)) {slot(spl[[i]], "ID") <- as.character(i)}
tracksSL <- SpatialLines(spl, proj4string = CRS("+proj=longlat +datum=WGS84"))

# view data
summary(tracksSL)
plot(tracksSL)

# make dataframe for merging with spatial data
names <- sub("[.]gpx$", "", basename(files))
df <- data.frame(names = names, row.names = sapply(slot(tracksSL, "lines"), function(x) slot(x, "ID")))

# spatial dataframe
tracksSLDF <- SpatialLinesDataFrame(tracksSL, data = df)

# write ressult to KML
writeOGR(tracksSLDF, dsn="tracks_collection.kml", layer= "Wolfi_Garda_Tracks", driver="KML", dataset_options=c("NameField=names"))

VBA Subroutine to Clear All Filters in Excel-Table

Sub filter_clear()

'****************************************************************************************************************
'author:    kay cichini
'date:      06072016
'purpose:   clear all filters in a preformated excel tabel
'****************************************************************************************************************

Dim SelectedCell As Range
Dim TableName As String
Dim ActiveTable As ListObject

Set SelectedCell = ActiveCell

'Determine if ActiveCell is inside a Table
  On Error GoTo NoTableSelected
    TableName = SelectedCell.ListObject.Name
    Set ActiveTable = ActiveSheet.ListObjects(TableName)

    If ActiveTable.ShowAutoFilter Then
      'MsgBox "AutoFilters are turned on"
      If ActiveTable.AutoFilter.FilterMode Then
        'MsgBox "Filter is actually set"
        ActiveTable.AutoFilter.ShowAllData
      End If
    End If
  On Error GoTo 0

Exit Sub

'Error Handling
NoTableSelected:
  MsgBox "There is no Table currently selected! (You need to activate a cell in the Table to be cleared!)", vbCritical

End Sub