Adjust vbscript to remove unwanted returns

I'm using some vbscript to manipulate csv files. Unfortunately, some of the csv input has unwanted returns in it. I'd like to add code to the script that will remove these unwanted returns, replace them with a single space, and then replace all instances of double-spaces with a single space. What do I need to add to the attached code to achieve this? And where best to add it? I've included the code, some sample input, and the sample replacement list files the code uses.

Note: The first column of the csv input MUST include an abbreviated state (or territory) name. If it does not, we know there's a line break problem that we need to fix. And: We can use the StateList.txt file to validate entries in the first column.

Function pd(n, totalDigits) 
        if totalDigits > len(n) then 
            pd = String(totalDigits-len(n),"0") & n 
        else 
            pd = n 
        end if 
End Function 

dteStart = Now


Dim Today

Today = pd(Month(date()),2) & "-" & _ 
        pd(Day(date()),2) & "-" & _ 
        Year(date())

Dim FileSys, MoveFile, i
Dim MyData, strData(), strStateData(), SplitUsingEqualTo, Search, strLine, strStateLine
Dim aCell

Const xlCellTypeLastCell = 11
Const xlCSV = 6
Const ForReading = 1

'~~> Change Path Here
InPutDirName = "C:\A_Testing\csvInput\"
OutPutDirName = "C:\A_Testing\csvOutput\"
ProcessedDirName = "C:\A_Testing\csvProcessed\"
ReplacementTextFile = "C:\A_Testing\csvProcessed\ReplacementList.txt"
StateTextFile = "C:\A_Testing\csvProcessed\StateList.txt"

Set objExcel = CreateObject("Excel.Application")
Set FileSys = CreateObject("Scripting.FileSystemObject")
Set objTextFile = FileSys.OpenTextFile(ReplacementTextFile, ForReading)
Set objStateTextFile = FileSys.OpenTextFile(StateTextFile, ForReading)

Set FileRetriever = FileSys.GetFolder(InPutDirName)
Set FileNames = FileRetriever.Files
 
i = 0

Do Until objTextFile.AtEndOfStream
    ReDim Preserve strData(i)
    strData(i) = objTextFile.ReadLine
    i = i + 1
Loop
objTextFile.Close
 
j = 0

Do Until objStateTextFile.AtEndOfStream
    ReDim Preserve strStateData(j)
    strStateData(j) = objStateTextFile.ReadLine
    j = j + 1
Loop
objStateTextFile.Close

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","")
        lastrow = objSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
        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]"
        objSheet.Cells(1, "Y") = "Topic"
        objSheet.Range("Y2:Y" & lastrow).FormulaR1C1 = topicName         
        
        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
        
        objWorkbook.SaveAs OutPutDirName & Replace(F.Name,".csv"," " & Today & ".csv"), xlCSV
				objWorkbook.Close (True)
				objExcel.DisplayAlerts = True
				objExcel.Quit
				FileSys.MoveFile InPutDirName & F.Name , ProcessedDirName & Replace(F.Name,".csv"," processed " & Today & ".csv")
        'Set MoveFile = FileSys.GetFile(InPutDirName & F.Name)
        'MoveFile.Move (ProcessedDirName)
    End If
Next

dteEnd = Now

MsgBox "Finished in " & DateDiff("s", dteStart, dteEnd) & " seconds."

Open in new window

Employee-Leave.csv ReplacementList.txt StateList.txt

GessWurkerAsked:
Who is Participating?
 
SiddharthRoutConnect With a Mentor Commented:
Here it is. Let me know if there are any errors.

Function pd(n, totalDigits)
        If totalDigits > Len(n) Then
            pd = String(totalDigits - Len(n), "0") & n
        Else
            pd = n
        End If
End Function

dteStart = Now

Today = pd(Month(Date), 2) & "-" & pd(Day(Date), 2) & "-" & Year(Date)

Dim FileSys, MoveFile, i
Dim MyData, strData(), strStateData(), SplitUsingEqualTo, Search, strLine, strStateLine
Dim aCell, Today

Const xlvalues = -4163
Const xlPart = 2
Const xlByRows = 1
Const xlNext = 1
Const xlCellTypeLastCell = 11
Const xlCSV = 6
Const ForReading = 1
Const xlUp = -4162

'~~> Change Path Here
InPutDirName = "C:\A_Testing\csvInput\"
OutPutDirName = "C:\A_Testing\csvOutput\"
ProcessedDirName = "C:\A_Testing\csvProcessed\"
ReplacementTextFile = "C:\A_Testing\csvProcessed\ReplacementList.txt"
StateTextFile = "C:\A_Testing\csvProcessed\StateList.txt"

Set objExcel = CreateObject("Excel.Application")
Set FileSys = CreateObject("Scripting.FileSystemObject")
Set objTextFile = FileSys.OpenTextFile(ReplacementTextFile, ForReading)
Set objStateTextFile = FileSys.OpenTextFile(StateTextFile, ForReading)

Set FileRetriever = FileSys.GetFolder(InPutDirName)
Set FileNames = FileRetriever.Files
 
i = 0

Do Until objTextFile.AtEndOfStream
    ReDim Preserve strData(i)
    strData(i) = objTextFile.ReadLine
    i = i + 1
Loop
objTextFile.Close
 
j = 0

Do Until objStateTextFile.AtEndOfStream
    ReDim Preserve strStateData(j)
    strStateData(j) = objStateTextFile.ReadLine
    j = j + 1
Loop
objStateTextFile.Close

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", "")
        lastrow = objSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
        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]"
        objSheet.Cells(1, "Y") = "Topic"
        objSheet.Range("Y2:Y" & lastrow).FormulaR1C1 = topicName
        
        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
    
        Do
            Set aCell = objSheet.Cells(1, "A")
            Set aCell = objSheet.Cells.Find("  ", aCell, xlvalues, xlPart, xlByRows, xlNext, False)
            If Not aCell Is Nothing Then
                aCell.Replace "  ", " ", xlPart, xlByRows, False, False, False
            End If
        Loop Until aCell Is Nothing
    
        Do
            Set aCell = objSheet.Cells(1, "A")
            Set aCell = objSheet.Cells.Find(Chr(10), aCell, xlvalues, xlPart, xlByRows, xlNext, False)
            If Not aCell Is Nothing Then
                aCell.Replace Chr(10), " ", xlPart, xlByRows, False, False, False
            End If
        Loop Until aCell Is Nothing
    
        lastrow = objSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    
        For i = lastrow To 2 Step -1
            If (Asc(UCase(Left(Trim(objSheet.Range("A" & i).Value), 1))) < 65 Or _
            Asc(UCase(Left(Trim(objSheet.Range("A" & i).Value), 1))) > 90) Or _
            (Asc(UCase(Mid(Trim(objSheet.Range("A" & i).Value), 2, 1))) < 65 Or _
            Asc(UCase(Mid(Trim(objSheet.Range("A" & i).Value), 2, 1)))) > 90 Or _
            (Asc(UCase(Mid(Trim(objSheet.Range("A" & i).Value), 7, 1))) < 65 Or _
            Asc(UCase(Mid(Trim(objSheet.Range("A" & i).Value), 7, 1)))) > 90 Or _
            (Asc(UCase(Mid(Trim(objSheet.Range("A" & i).Value), 3, 1))) < 48 Or _
            Asc(UCase(Mid(Trim(objSheet.Range("A" & i).Value), 3, 1)))) > 57 Or _
            (Asc(UCase(Mid(Trim(objSheet.Range("A" & i).Value), 4, 1))) < 48 Or _
            Asc(UCase(Mid(Trim(objSheet.Range("A" & i).Value), 4, 1)))) > 57 Or _
            (Asc(UCase(Mid(Trim(objSheet.Range("A" & i).Value), 5, 1))) < 48 Or _
            Asc(UCase(Mid(Trim(objSheet.Range("A" & i).Value), 5, 1)))) > 57 Or _
            (Asc(UCase(Mid(Trim(objSheet.Range("A" & i).Value), 6, 1))) < 48 Or _
            Asc(UCase(Mid(Trim(objSheet.Range("A" & i).Value), 6, 1)))) > 57 Then
                For j = 1 To 26
                    If Len(Trim(objSheet.Cells(i, j).Value)) <> 0 Then
                        objSheet.Range("T" & i - 1).Value = objSheet.Range("T" & i - 1).Value & Chr(13) & Trim(objSheet.Cells(i, j).Value)
                    End If
                Next
                objSheet.Rows(i).Delete xlUp
            End If
        Next
        
        objWorkbook.SaveAs OutPutDirName & Replace(F.Name, ".csv", " " & Today & ".csv"), xlCSV
        objWorkbook.Close (True)
        objExcel.DisplayAlerts = True
        objExcel.Quit
        FileSys.MoveFile InPutDirName & F.Name, ProcessedDirName & Replace(F.Name, ".csv", " processed " & Today & ".csv")
    End If
Next

dteEnd = Now

MsgBox "Finished in " & DateDiff("s", dteStart, dteEnd) & " seconds."

Open in new window


Sid
0
 
SiddharthRoutCommented:
Try this

Insert this code in line 84.

    Dim acell As Range
    
    Do
        Set acell = objSheet.Cells.Find(What:="  ", LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If Not acell Is Nothing Then
            acell.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        End If
    Loop Until acell Is Nothing
    
    Do
        Set acell = objSheet.Cells.Find(What:=Chr(10), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        objSheet.Columns(1).Replace What:=Chr(10), Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    Loop Until acell Is Nothing

Open in new window


Sid
0
 
GessWurkerAuthor Commented:
Sid: Tried it. Got following:

Line: 86
Char: 9
Error: Name redefined
Code: 800A0411
Source: Microsoft VBScript compilation error

Now I'll see if I can figure it out.
0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
GessWurkerAuthor Commented:
ah... can't re-use that variable?
0
 
SiddharthRoutCommented:
Oops i forgot you were doing this in vbscript.

Replace

Dim acell As Range

by this

Dim acell As Object

An also declare these at the top

Const xlvalues = -4163
Const xlPart = 2
Const xlByRows = 1
Const xlNext = 1

Now try.

Sid

0
 
SiddharthRoutCommented:
Sorry

Dim acell

and not

Dim acell As Object

Sid
0
 
GessWurkerAuthor Commented:
Sid: I still get "Name redefined" error
0
 
GessWurkerAuthor Commented:
Still "Name redefined" error
0
 
SiddharthRoutCommented:
Post the latest code that you are using and also tell me the line number.

Sid
0
 
GessWurkerAuthor Commented:
To clarify:

Dim acell as Range   --> doesn't work
Dim acell as Object   --> doesn't work
Dim acell   --> doesn't work
0
 
SiddharthRoutCommented:
Can you post the complete code so that I can test?

Sid
0
 
GessWurkerAuthor Commented:
Your const entries towards the top. Your other code additions around line 90. Cheers!
Function pd(n, totalDigits) 
        if totalDigits > len(n) then 
            pd = String(totalDigits-len(n),"0") & n 
        else 
            pd = n 
        end if 
End Function 

dteStart = Now


Dim Today

Today = pd(Month(date()),2) & "-" & _ 
        pd(Day(date()),2) & "-" & _ 
        Year(date())

Dim FileSys, MoveFile, i
Dim MyData, strData(), strStateData(), SplitUsingEqualTo, Search, strLine, strStateLine
Dim aCell

Const xlvalues = -4163
Const xlPart = 2
Const xlByRows = 1
Const xlNext = 1
Const xlCellTypeLastCell = 11
Const xlCSV = 6
Const ForReading = 1

'~~> Change Path Here
InPutDirName = "C:\A_Testing\csvInput\"
OutPutDirName = "C:\A_Testing\csvOutput\"
ProcessedDirName = "C:\A_Testing\csvProcessed\"
ReplacementTextFile = "C:\A_Testing\csvProcessed\ReplacementList.txt"
StateTextFile = "C:\A_Testing\csvProcessed\StateList.txt"

Set objExcel = CreateObject("Excel.Application")
Set FileSys = CreateObject("Scripting.FileSystemObject")
Set objTextFile = FileSys.OpenTextFile(ReplacementTextFile, ForReading)
Set objStateTextFile = FileSys.OpenTextFile(StateTextFile, ForReading)

Set FileRetriever = FileSys.GetFolder(InPutDirName)
Set FileNames = FileRetriever.Files
 
i = 0

Do Until objTextFile.AtEndOfStream
    ReDim Preserve strData(i)
    strData(i) = objTextFile.ReadLine
    i = i + 1
Loop
objTextFile.Close
 
j = 0

Do Until objStateTextFile.AtEndOfStream
    ReDim Preserve strStateData(j)
    strStateData(j) = objStateTextFile.ReadLine
    j = j + 1
Loop
objStateTextFile.Close

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","")
        lastrow = objSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
        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]"
        objSheet.Cells(1, "Y") = "Topic"
        objSheet.Range("Y2:Y" & lastrow).FormulaR1C1 = topicName         
        
        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
    
    Dim acell
    
    Do
        Set acell = objSheet.Cells.Find(What:="  ", LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If Not acell Is Nothing Then
            acell.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        End If
    Loop Until acell Is Nothing
    
    Do
        Set acell = objSheet.Cells.Find(What:=Chr(10), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        objSheet.Columns(1).Replace What:=Chr(10), Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    Loop Until acell Is Nothing        
        objWorkbook.SaveAs OutPutDirName & Replace(F.Name,".csv"," " & Today & ".csv"), xlCSV
				objWorkbook.Close (True)
				objExcel.DisplayAlerts = True
				objExcel.Quit
				FileSys.MoveFile InPutDirName & F.Name , ProcessedDirName & Replace(F.Name,".csv"," processed " & Today & ".csv")
        'Set MoveFile = FileSys.GetFile(InPutDirName & F.Name)
        'MoveFile.Move (ProcessedDirName)
    End If
Next

dteEnd = Now

MsgBox "Finished in " & DateDiff("s", dteStart, dteEnd) & " seconds."

Open in new window

0
 
SiddharthRoutCommented:
Remove   Dim acell from line 89.

You have already defined it in Line 20 :)

Now try

Sid
0
 
GessWurkerAuthor Commented:
DOH!  Pretty sure I mentioned that!!  

No worries... I'll give it another shot...
0
 
GessWurkerAuthor Commented:
Ok. Got another error. Expected ')' at line 93.

I've got a request: Can you run the code first and verify that it works? Once you've verified working code, please post it.

Thanks!
0
 
SiddharthRoutCommented:
Ok. let me download all the files.

Sid
0
 
SiddharthRoutCommented:
Please check if the output is correct? If it is then I will upload the code.

Sid
Employee-Leave-02-11-2011.csv
0
 
GessWurkerAuthor Commented:
Hi Sid. Sorry for the delay.

Nope. We're not there yet. Your output:

line 9:referred to SENATE Committee on RULES.MasterLaborRule;PSL;WorkersComp;WorkersComp,referred to SENATE Committee on RULES.,Master,,LaborRule;PSL;WorkersComp;WorkersComp,,,,,,,,,,,,,,,,,,,,Employee-Leave

1st col should always contain RecordID (e.g., AR2011H1024, AZ2011S1264, CA2011A11, etc)
0
 
SiddharthRoutCommented:
Hmm... Your input file has that line.

What should I be doing in the code? Delete that line?

Sid
0
 
GessWurkerAuthor Commented:
No. That line is an example of the problem. It actually belongs to the previous line. An unwanted line-break in the previous line bumped the 2nd half of line 8 down do line 9. Col 1 should always contain a record id. If we ever come across a col 1 that doesn't contain a record ID, we know there's an unwanted line break in the previous line.
0
 
SiddharthRoutCommented:
Oh Ok I get it.

So in the above file it belongs to Line 8 Column T?

Sid
0
 
GessWurkerAuthor Commented:
Exactly
0
 
SiddharthRoutCommented:
One last question before I update the code.

In the current output above, All the data above in col 9 will go into Col T or will be divided into other columns?

Sid
0
 
SiddharthRoutCommented:
I also realized, do you have a set format for the record ID?

For example First 2 should be letter and then followed by 4 numbers and then 1 letter?

The reason why I ask is so that I know how to identify a record ID in the code.

Sid
0
 
GessWurkerAuthor Commented:
The RecordID is concatenated from the first 5 columns of the original input. See the first 5 cols of employee leave.csv attached to my initial post.
0
 
SiddharthRoutCommented:
Please confirm if the output is correct?

Sid
Employee-Leave-02-15-2011.csv
0
 
GessWurkerAuthor Commented:
The sample looks good, Sid! Now let's see that code so I can give it a workout!  :-)
0
 
GessWurkerAuthor Commented:
Sid: It does the job! Sure seems to work hard at it (add quite a bit of processing time), but it completes successfully! Thanks a bunch!  Cheers - gesswurker
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.