Concatenate or Textjoin for table rows based on criteria-CodePudding

I have a GPS track file that I am importing into Excel (multiple cars in same file) and I want to manipulate and export the data so that it conforms to a gpx file type for a single chosen car. Some of the columns are not needed from the original file and some text needs to be added between the existing columns. I have built a macro that will do half of what I want but it copies the entire row for that car instead of getting the data in the form I need.

In excel I can use the textjoin formula to achieve the goal I have but I want it to be a macro and that's where I am having the problem. Below is some sample data and my macro. I would enter the car number I am looking for into C21 on sheet1 and only rows that are for that car# (column b) would be moved to sheet2. The format I need is "trkpt lat="insert lat" lon="insert lon" time/insert time/" and this is where I would concat or textjoin specific portions of the original row onto sheet2 but in the above mentioned format. Here is an example of the data and my macro that is only working to copy the entire row

Date/Time          Car# Junk Lat        Lon         Junk2       Converted Date/Time
20221125050122ES    6   0    27.19483   -82.43863   x           2022-11-25T05:01:22-05:00
20221125050158ES    6   0    27.20587   -82.44154   x           2022-11-25T05:01:58-05:00
20221125052215ES    1   0    27.35147   -82.47196   x           2022-11-25T05:22:15-05:00
20221125052355ES    2   0    27.14018   -82.41795   x           2022-11-25T05:23:55-05:00
20221125052449ES    2   0    27.15536   -82.42394   x           2022-11-25T05:24:49-05:00
20221125052519ES    1   0    27.35149   -82.47195   x           2022-11-25T05:25:19-05:00
20221125052539ES    2   0    27.16463   -82.431     x           2022-11-25T05:25:39-05:00
20221125054932ES    3   0    27.2988    -82.44879   x           2022-11-25T05:49:32-05:00
20221125055059ES    3   0    27.27847   -82.44901   x           2022-11-25T05:50:59-05:00
20221125055519ES    4   0    27.31564   -82.26689   x           2022-11-25T05:55:19-05:00
20221125060022ES    4   0    27.31564   -82.26692   x           2022-11-25T06:00:22-05:00
20221125060106ES    6   0    27.18927   -82.43754   x           2022-11-25T06:01:06-05:00
20221125062409ES    2   0    27.14827   -82.41893   x           2022-11-25T06:24:09-05:00
20221125064901ES    3   0    27.29893   -82.4458    x           2022-11-25T06:49:01-05:00
20221125065650ES    4   0    27.31566   -82.26689   x           2022-11-25T06:56:50-05:00
20221125065821ES    4   0    27.31564   -82.26691   x           2022-11-25T06:58:21-05:00
20221125072115ES    1   0    27.35146   -82.47197   x           2022-11-25T07:21:15-05:00

Sub Getdata()
Dim DriverRange As Range
Worksheets(1).Select
Set DriverRange = Worksheets(1).Range("B1", Range("B" & Rows.Count).End(xlUp))
For Each cell In DriverRange
  If cell.Value = Worksheets(1).Range("C21") Then
    lr = Worksheets(2).Range("A" & Rows.Count).End(xlUp).Row
    cell.EntireRow.Copy Destination:=Worksheets(2).Range("A" & lr   1)
  End If
Next cell
End Sub

output desired when searching for car 6
trkpt lat="27.19483" lon="-82.43863" time/2022-11-25T05:01:22-05:00/
trkpt lat="27.20587" lon="-82.44154" time/2022-11-25T05:01:58-05:00/
trkpt lat="27.18927" lon="-82.43754" time/2022-11-25T06:01:06-05:00/

I have tried several versions of the textjoin worksheet function that would replace the cell.entirerow.copy line of code but it does not grab the correct rows that match up with the car I want. I feel I am headed in the right direction but am missing something.

CodePudding user response：

Please, try the next code. It should be very fast, using arrays and dropping the processing result at once. I cannot see the column headers, but the code assumes that the data to be processed starts from "A:A" column and ends to "G:G" one, second row:

Sub Getdata()
  Dim wsSource As Worksheet, wsDest As Worksheet, lastR As Long
  Dim arrS, arrD, i As Long, k As Long
  Const carNo As Long = 6  'place here the car number
  
  Set wsSource = Worksheets(1)
  Set wsDest = Worksheets(2)
  
  lastR = wsSource.Range("A" & wsSource.rows.count).End(xlUp).row
  arrS = wsSource.Range("A2:G" & lastR).Value 'place the range in an array for faster iteration/processing
  
  ReDim arrD(1 To UBound(arrS), 1 To 3) 'redim the destination array as its maximum possible number of rows
  For i = 1 To UBound(arrS)
        If arrS(i, 2) = carNo Then
            k = k   1
            arrD(k, 1) = "trkpt lat=""" & arrS(i, 4) & """"
            arrD(k, 2) = "lon=""" & arrS(i, 5) & """"
            arrD(k, 3) = "time/" & arrS(i, 7) & "/"
        End If
  Next i
  If k > 0 Then
        wsDest.Range("A2").Resize(k, 3).Value = arrD
 End If
 
 MsgBox "Ready...": wsDest.Activate
End Sub

Please, send some feedback after testing it.