Fix concatenation method and include separators

I use a vb script to reformat CSV I receive from a vendor on a daily basis. I've started receiving a new batch of fields (columns) that I need to concatenate AND insert separators between values. Currently, my tortured method is below:

objSheet.Range("X2:X" & lastrow).FormulaR1C1 = "=RC[5] & "";"" & RC[6] & "";"" & RC[7] & "";""& RC[8] & "";"" & RC[9] & "";"" & RC[10] & "";"" & RC[11] & "";"" & RC[12] & "";"" & RC[13] & "";""

However, this results in a whole lot of orphan semi-colons whenever a column is empty. I've tried TEXTJOIN like so:

objSheet.Range("X2:X" & lastrow).FormulaR1C1 = "=TEXTJOIN("";"",TRUE,RC[5]:RC[16])"

but that failed.

Can somebody provide an alternative method that won't end up creating entries like this?

;;;;subject5;;subject7;;;;subject11
GessWurkerAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Dale FyeOwner, Developing Solutions LLCCommented:
Well, in order to read each record correctly, you are going to have to end up with a string which contains enough column separators (;) for the import process to properly put "Subject5", "Subject7", and "Subject11" in the appropriate columns.  So if a particular record contains no other information than those three text columns, then your string will always look like this.

I wrote an article a while back about parsing a CSV file prior to importing into Access, which should work similarly for your import into Excel.  Check it out at:
0
GessWurkerAuthor Commented:
Thanks. The script I'm using is many years old, not originally written by me and only slightly modified my me over the years (as necessary and as I was able). However, this latest mod goes beyond my skill level. I'll keep at it. Here's a snippet of the relevant portions:

For Each F In FileNames
    If LCase(Right(CStr(F.Name), 4)) = ".csv" Then
        Set objWorkbook = objExcel.Workbooks.Open(InPutDirName & F.Name)
        Set objSheet = objWorkbook.Sheets(1)
        topicName = Replace(F.Name,".csv","")
        If LCase(topicName) = "employeeleave" Then topicName = "Employee Leave" End If
        lastrow = objSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
        objSheet.Cells(1, "X") = "Subject"
        objSheet.Range("X2:X" & lastrow).FormulaR1C1 = "=RC[5] & "";"" & RC[6] & "";"" & RC[7] & "";""& RC[8] & "";"" & RC[9] & "";"" & RC[10] & "";"" & RC[11] & "";"" & RC[12] & "";"" & RC[13] & "";"" & RC[14] & "";"" & RC[15] & "";"" & RC[16]"  'Sort of works. Problematic.
      ' DOES NOT WORK objSheet.Range("X2:X" & lastrow).FormulaR1C1 = "=TEXTJOIN("";"",TRUE,RC[5]:RC[16])" 'DOES NOT WORK
      objSheet.Cells(1, "Y") = "Topic"
        objSheet.Range("Y2:Y" & lastrow).FormulaR1C1 = topicName        
        objSheet.Cells(1, "Z") = "StateNetModified"
        objSheet.Range("Z2:Z" & lastrow).FormulaR1C1 = Today        
        objSheet.Cells(1, "AA") = "ForFederalSort"
        objSheet.Range("AA2:AA" & lastrow).FormulaR1C1 = "=if(RC[-26]=""US"",""Federal"","""")"
        objSheet.Cells(1, "AB") = "NoMajorChanges"
        objSheet.Range("AB2:AB" & lastrow).FormulaR1C1 = bulletChar        
        objSheet.Columns(1).Insert
        objSheet.Cells(1, "A") = "RecordID"
'        objSheet.Range("A2:A" & lastrow).FormulaR1C1 = "=RC[1]&RC[2]&RC[3]&RC[4]&RC[5]&RC[25]"
        objSheet.Range("A2:A" & lastrow).FormulaR1C1 = "=RC[1]&RC[2]&RC[3]&RC[4]&RC[5]"
'        Msgbox (CStr(objSheet.Range("K2").value))
        objExcel.DisplayAlerts = False
       
'        For Each strLine In strData
'            SplitUsingEqualTo = Split(strLine, "=")
'            objSheet.Columns(24).Replace SplitUsingEqualTo(0), SplitUsingEqualTo(1),2,1,True
'  Next
 
        objSheet.Range("A2:A" & lastrow).value = objSheet.Range("A2:A" & lastrow).value
        For Each strStateLine In strStateData
            SplitUsingEqualTo = Split(strStateLine, "=")
            objSheet.Columns(2).Replace SplitUsingEqualTo(0), SplitUsingEqualTo(1),1,1,True
        Next

        'Msgbox SortText("Z;L;B;I;A;J")
'            objSheet.Range("K2:K" & lastrow).value = SortText(objSheet.Range("K2:K" & lastrow).value)
 
    'Reads all Values From column K and try to apply the function
    Dim objRange
    Dim intRow
    Dim strColValue
    Set objRange = objSheet.Range("L2")
   
    For intRow = 1 To (lastrow - 1)
      strColValue = SortText(objRange(intRow, 1).Value)
        objRange(intRow, 1).Value = SortText(strColValue)
    Next

    'Reverse sorting Status Field
    Dim objRangeRev
    Dim intRowRev
    Dim strColValueRev
    Set objRangeRev = objSheet.Range("V2")
   
    For intRowRev = 1 To (lastrow - 1)
      strColValueRev = objRangeRev(intRowRev, 1).Value
        objRangeRev(intRowRev, 1).Value = ReverseSortText(strColValueRev)
    Next

            
'            strRecordIDs = RecIDDirName & Replace(F.Name,".csv"," " & Today & ".csv")
'            Set objRecordIDs = FileSys.CreateTextFile(strRecordIDs, True)
'            
'                For intRow = 2 To lastrow
'                        objRecordIDs.WriteLine objSheet.Cells(intRow, "A").Value
'                Next
            
'                objRecordIDs.Close
        objWorkbook.SaveAs OutPutDirName & Replace(F.Name,".csv"," " & CreateGUID() & ".csv"), xlCSV
'doesn't work, breaks concatenation of subjects            objSheet.Columns("AN").EntireColumn.Delete            
                        objWorkbook.Close (True)
                        objExcel.DisplayAlerts = True
                        objExcel.Quit
                        FileSys.MoveFile InPutDirName & F.Name , ProcessedDirName & Replace(F.Name,".csv"," processed " & CreateGUID() & ".csv")
        'Set MoveFile = FileSys.GetFile(InPutDirName & F.Name)
        'MoveFile.Move (ProcessedDirName)
    End If
Next
0
Ejgil HedegaardCommented:
You can insert an if statement for each ";" so ";" is only added when the next cell is not empty, like
"=RC[5]&IF(RC[6]<>"""","";"","""")&RC[6]&IF(RC[7]<>"""","","","""")&RC[7]" etc.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

GessWurkerAuthor Commented:
Ejgil - Worked perfectly!  Cheers. Only slightly altered:

            objSheet.Range("X2:X" & lastrow).FormulaR1C1 = "=RC[5]&IF(RC[5]<>"""","";"","""")&RC[6]&IF(RC[6]<>"""","";"","""")&RC[7]&IF(RC[7]<>"""","";"","""")&RC[8]&IF(RC[8]<>"""","";"","""")&RC[9]&IF(RC[9]<>"""","";"","""")&RC[10]&IF(RC[10]<>"""","";"","""")&RC[11]&IF(RC[11]<>"""","";"","""")&RC[12]&IF(RC[12]<>"""","";"","""")&RC[13]&IF(RC[13]<>"""","";"","""")&RC[14]&IF(RC[14]<>"""","";"","""")"
0
GessWurkerAuthor Commented:
Thanks so much!
0
NorieAnalyst Assistant Commented:
Why not use a UDF?
Function ConcatWOBlanks(rng As Range, Optional ConcatChar = ";") As String
Dim cl As Range
Dim arrVals() As Variant
Dim Cnt As Long

    ReDim arrVals(1 To rng.Cells.Count)

    For Each cl In rng.Cells
        If cl.Value <> "" Then
            Cnt = Cnt + 1
            arrVals(Cnt) = cl.Value
       End If
   Next cl

   If Cnt > 0 Then
       ReDim Preserve arrVals(1 To Cnt)
       ConcatWOBlanks = Join(arrVals, ConcatChar)
   End If

End Function

Open in new window


You could use this in your code like this.
 objSheet.Range("X2:X" & lastrow).FormulaR1C1 = "=ConcatWOBlanks(RC[5]:RC[14], "";"")"

Open in new window

0
GessWurkerAuthor Commented:
Hi, Norie. Your solution looks great, but it returns an error at the first line

Line 132: Function ConcatWOBlanks(rng As Range, Optional ConcatChar = ";") As String

Line: 132
Char: 29
Error: Expected ')'
0
NorieAnalyst Assistant Commented:
How did you use the code I posted?

It would go in  a separate module and would be used in your existing code as I showed above.
0
GessWurkerAuthor Commented:
My script contains several functions already. I added it AFTER a CreateGuid() function, like so:

Function CreateGUID()
  numChars = 10 'CHANGE this variable for the length of the characters after the date
  Randomize Timer
  Dim tmpCounter,tmpGUID
  tmpGUID = Right("0" & Month(Now()),2)
  tmpGUID = tmpGUID & "-" & Right("0" & Day(Now()),2)
  tmpGUID = tmpGUID & "-" & Right(Year(Now()),2) & "_"
  Const strValid = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  For tmpCounter = 1 To numChars
    tmpGUID = tmpGUID & Mid(strValid, Int(Rnd(1) * Len(strValid)) + 1, 1)
  Next
  CreateGUID = tmpGUID
End Function


Function ConcatWOBlanks(rng As Range, Optional ConcatChar = ";") As String
Dim cl As Range
Dim arrVals() As Variant
Dim Cnt As Long

    ReDim arrVals(1 To rng.Cells.Count)

    For Each cl In rng.Cells
        If cl.Value <> "" Then
            Cnt = Cnt + 1
            arrVals(Cnt) = cl.Value
       End If
   Next cl

   If Cnt > 0 Then
       ReDim Preserve arrVals(1 To Cnt)
       ConcatWOBlanks = Join(arrVals, ConcatChar)
   End If

End Function
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.