Fix concatenation method and include separators

GessWurker
GessWurker used Ask the Experts™
on
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

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Dale FyeOwner, Dev-Soln LLC
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
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.
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

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

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

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

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial