We help IT Professionals succeed at work.

Fix concatenation method and include separators

99 Views
Last Modified: 2018-09-24
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
Comment
Watch Question

Dale FyeOwner, Dev-Soln LLC
CERTIFIED EXPERT
Most Valuable Expert 2014
Top Expert 2010

Commented:
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:

Author

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
CERTIFIED EXPERT
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION

Author

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]<>"""","";"","""")"

Author

Commented:
Thanks so much!
NorieAnalyst Assistant
CERTIFIED EXPERT

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

Author

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 ')'
NorieAnalyst Assistant
CERTIFIED EXPERT

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.

Author

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

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions