For downloaded trip spreadsheets for Peaks and Professors, formats & copies each sheet, allowing easy import into Google Sheets

format_peaks_trip_sheets.vba

Sub PeaksTripPrep()
'
' PeaksTripPrep Macro
'
' Keyboard Shortcut: Ctrl+p
'
Dim rngName As Range
Dim rngDate As Range
Dim rngHowMany As Range
Dim rngPayment As Range
Dim rngCanDrive As Range
Dim rngPhone As Range
Dim Lastrow As Integer
    

    Dim ws As Worksheet

    Set ws = ActiveWorkbook.ActiveSheet

    With ws
        Lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
        Set rngDate = .Range("1:1").Find(What:="Registration Date", MatchCase:=False)
        Set rngHowMany = .Range("1:1").Find(What:="How many", MatchCase:=False)
        Set rngPayment = .Range("1:1").Find(What:="Payment Status", MatchCase:=False)
        Set rngCanDrive = .Range("1:1").Find(What:="Can you drive?", MatchCase:=False)
        Columns("D:D").Select
        Selection.NumberFormat = "0"
        Cells.Select
        With .Sort
            .SortFields.Clear
            If Not rngDate Is Nothing Then
                .SortFields.Add Key:=rngDate, _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End If
            .SetRange ws.Cells
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Columns("E:E").Select
        Selection.ClearContents
        If Not rngPayment Is Nothing And Not rngHowMany Is Nothing Then
            If WorksheetFunction.CountA(Range("Q2:Q" & Lastrow)) = 0 Then
                Columns("F:F").Select
                Selection.ClearContents
                Columns("E:F").Select
                Selection.Delete Shift:=xlToLeft
            Else
                Columns("E:E").Select
                Selection.Delete Shift:=xlToLeft
            End If
        Else
            Columns("F:F").Select
            Selection.ClearContents
        End If

        For Each rngPhone In .Range("D2:D" & Lastrow).Cells
            Dim i As Integer
            Dim strSource As String
            Dim strResult As String
            strSource = rngPhone.Value
            For i = 1 To Len(strSource)
                Select Case Asc(Mid(strSource, i, 1))
                    Case 48 To 57, 65 To 90, 97 To 122: 'include 32 if you want to include space
                        strResult = strResult & Mid(strSource, i, 1)
                End Select
            Next
            rngPhone.Value = strResult
            strResult = ""
            
        Next
        Columns("H:Q").Select
        Selection.Delete Shift:=xlToLeft
        Range("A2:G" & Lastrow).Select
        Selection.Copy
    End With

End Sub