Solved

Adjust vbscript to remove unwanted returns

Posted on 2011-02-10
28
761 Views
Last Modified: 2012-05-11
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

0
Comment
Question by:GessWurker
  • 14
  • 14
28 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34864901
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
 

Author Comment

by:GessWurker
ID: 34864999
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
 

Author Comment

by:GessWurker
ID: 34865005
ah... can't re-use that variable?
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34865035
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34865047
Sorry

Dim acell

and not

Dim acell As Object

Sid
0
 

Author Comment

by:GessWurker
ID: 34865080
Sid: I still get "Name redefined" error
0
 

Author Comment

by:GessWurker
ID: 34865116
Still "Name redefined" error
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34865124
Post the latest code that you are using and also tell me the line number.

Sid
0
 

Author Comment

by:GessWurker
ID: 34865130
To clarify:

Dim acell as Range   --> doesn't work
Dim acell as Object   --> doesn't work
Dim acell   --> doesn't work
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34865150
Can you post the complete code so that I can test?

Sid
0
 

Author Comment

by:GessWurker
ID: 34865173
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34865432
Remove   Dim acell from line 89.

You have already defined it in Line 20 :)

Now try

Sid
0
 

Author Comment

by:GessWurker
ID: 34865508
DOH!  Pretty sure I mentioned that!!  

No worries... I'll give it another shot...
0
 

Author Comment

by:GessWurker
ID: 34865527
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
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34865542
Ok. let me download all the files.

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34866808
Please check if the output is correct? If it is then I will upload the code.

Sid
Employee-Leave-02-11-2011.csv
0
 

Author Comment

by:GessWurker
ID: 34890720
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34891041
Hmm... Your input file has that line.

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

Sid
0
 

Author Comment

by:GessWurker
ID: 34891109
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34891128
Oh Ok I get it.

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

Sid
0
 

Author Comment

by:GessWurker
ID: 34891140
Exactly
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34891165
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34891239
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
 

Author Comment

by:GessWurker
ID: 34891430
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34892084
Please confirm if the output is correct?

Sid
Employee-Leave-02-15-2011.csv
0
 

Author Comment

by:GessWurker
ID: 34892188
The sample looks good, Sid! Now let's see that code so I can give it a workout!  :-)
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 500 total points
ID: 34892232
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
 

Author Comment

by:GessWurker
ID: 34929215
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

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28455246.html)28455246) Here (http…
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now