Link to home
Start Free TrialLog in
Avatar of jon1966
jon1966Flag for United States of America

asked on

VBScript that removes duplicate fields from fixed field length files

Hi All,

I've had two nice fellas help me with scripting so far.  I would like to take this script a bit further, and remove any duplicates that occur within the "Account" field.  

The most important criteria though is that the "Levy" field drop anything below the 2500 threshold, which it is doing, so any duplicate removing logic should not interfere with that, just saying...

Any and all help appreciated,

Thanks

J
' Define needed constants
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
Const xlSaveChanges = 1 'Excel Save Changes
Const xlAscending = 1 'Excel Sort Ascending
Const xlDescending = 2 'Excel Sort Decending
Const xlYes = 1 'Excel Header Row Exists

cTab = Chr(9)

' Get input and output file names from command line parms
If (WScript.Arguments.Count > 0) Then
    sInfile = WScript.Arguments(0)
Else
    WScript.Echo "No input filename specified."
    WScript.Quit
End If
If (WScript.Arguments.Count > 1) Then
    sOutfile = WScript.Arguments(1)
Else
    WScript.Echo "No output filename specified."
    WScript.Quit
End If

'Create Excel Object
Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False 'Disable Overwrite Prompts
objExcel.Visible = True 'Hides Excel window

'Create Excel worksheet and add header row
objExcel.Workbooks.Add()
objExcel.Cells(1, 1) = "Account"
objExcel.Cells(1, 2) = "Year"
objExcel.Cells(1, 3) = "LevyBalance"
objExcel.Cells(1, 4) = "Owner"
objExcel.Cells(1, 5) = "Address2"
objExcel.Cells(1, 6) = "Address3"
objExcel.Cells(1, 7) = "Address4"
objExcel.Cells(1, 8) = "City"
objExcel.Cells(1, 9) = "State"
objExcel.Cells(1, 10) = "ZipCode"
intRow = 2 'Set first row to add data

' Create file system object
Set oFSO = CreateObject("Scripting.FileSystemObject")

' Read entire input file into a variable and close it
Set oInfile = oFSO.OpenTextFile(sInfile, ForReading, False, TriStateUseDefault)

Do While Not oInfile.AtEndOfStream
    sLine = oInfile.ReadLine
    Account = Trim(Mid(sLine, 1, 22))
    TYear = Trim(Mid(sLine, 23, 4))
    Over65 = Trim(Mid(sLine, 65, 1))
    Veteran = Trim(Mid(sLine, 66, 1))
    Disabled = Trim(Mid(sLine, 67, 1))
    DatePaid = Trim(Mid(sLine, 69, 8))
    LevyBalance = Trim(Mid(sLine, 87, 11))
    BankRupt = Trim(Mid(sLine, 139, 1))
    Owner = Trim(Mid(sLine, 202, 40))
    Address2 = Trim(Mid(sLine, 242, 40))
    Address3 = Trim(Mid(sLine, 282, 40))
    Address4 = Trim(Mid(sLine, 322, 40))
    City = Trim(Mid(sLine, 362, 24))
    State = Trim(Mid(sLine, 386, 2))
    ZipCode = Mid(sLine, 388, 5) & "-" & Mid(sLine, 393, 4)
           
    If (TYear <> "" And CLng(TYear) < 2010) And Over65 = "" And Veteran = "" And Disabled = "" And DatePaid = "" And ( LevyBalance <> "" And CLng(LevyBalance) >= 2500 ) And BankRupt = "" Then
        objExcel.Cells(intRow, 1) = Account
        objExcel.Cells(intRow, 2) = TYear
        objExcel.Cells(intRow, 3) = LevyBalance
        objExcel.Cells(intRow, 4) = Owner
        objExcel.Cells(intRow, 5) = Address2
        objExcel.Cells(intRow, 6) = Address3
        objExcel.Cells(intRow, 7) = Address4
        objExcel.Cells(intRow, 8) = City
        objExcel.Cells(intRow, 9) = State
        objExcel.Cells(intRow, 10) = ZipCode
        intRow = intRow + 1
    End If
Loop

'Format and Sort Excel workbook

Set objSheet = objExcel.ActiveWorkbook.ActiveSheet
objSheet.Columns("A:A").NumberFormat = "0"
Set objRange = objSheet.UsedRange
objRange.EntireColumn.AutoFit()
For iW = objRange.Column To objRange.Columns.Count
    colWidth = objSheet.Columns(iW).ColumnWidth
    objSheet.Columns(iW).ColumnWidth = colWidth + 5
Next
	
'Save Excel Workbook
objExcel.ActiveWorkbook.SaveAs(sOutfile)
'objExcel.ActiveWorkbook.Close xlSaveChanges
'objExcel.Quit
WScript.Echo "Script Finished"

' Cleanup and end
oInfile.Close
Set oInfile = Nothing
Set oFSO = Nothing

Open in new window

Avatar of balatheexpert
balatheexpert

'just above the "format and sort excel workbook" comment of yours, add this code:
For i = 2 To ActiveSheet.UsedRange.Rows.Count
doitagain:
Application.DisplayAlerts = False
If (Excel.WorksheetFunction.CountIf(Range("A2:A" & i), Range("A" & i)) > 1) Then
Rows(i).Delete
Application.DisplayAlerts = True
GoTo doitagain
End If
Next i




'this removes the any account's occurance of 2nd time or more, keeps the first occurance

let me know if this solves your issue!!

Thanks,
Bala
Avatar of jon1966

ASKER

Hi,

But what if the first occurrence is an account with levy below $2500 and the 2nd account is above $2500.  Or, will the >2500 test occur beforehand?

J
this is done once the previous conditions are satisfied and the data is put in the excel sheet!!

so it will work fine!!

Thanks,
Bala
Avatar of jon1966

ASKER

Cool, thank you.

I receive the following...  

D:\J&L\Customer\MDL\Fort Bend\trwfile.1021796\usr2\spool\act\ftbend-504-process-rev13.vbs(91, 1) Microsoft VBScript compilation error: Expected statement

where 91 is "GoTo doitagain".

Just curious, but on the error code (91, 1).  I know that 91 is the line # but what does the 1 stand for?


J
it works fine in my end.... i had sample data on my machine....

pls do something.. run the macro until ur macro!! and attach the file for me.. will check and let you know...
Avatar of jon1966

ASKER

Hi,

I have attached the code that I am using, maybe I entered it wrong.

I am just doing "cscript process-rev13.vbs flat1021796 flat1021796-13-out" when I receive the error, I just tested again.
Define needed constants
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
Const xlSaveChanges = 1 'Excel Save Changes
Const xlAscending = 1 'Excel Sort Ascending
Const xlDescending = 2 'Excel Sort Decending
Const xlYes = 1 'Excel Header Row Exists

cTab = Chr(9)

' Get input and output file names from command line parms
If (WScript.Arguments.Count > 0) Then
    sInfile = WScript.Arguments(0)
Else
    WScript.Echo "No input filename specified."
    WScript.Quit
End If
If (WScript.Arguments.Count > 1) Then
    sOutfile = WScript.Arguments(1)
Else
    WScript.Echo "No output filename specified."
    WScript.Quit
End If

'Create Excel Object
Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False 'Disable Overwrite Prompts
objExcel.Visible = True 'Hides Excel window

'Create Excel worksheet and add header row
objExcel.Workbooks.Add()
objExcel.Cells(1, 1) = "Account"
objExcel.Cells(1, 2) = "Year"
objExcel.Cells(1, 3) = "LevyBalance"
objExcel.Cells(1, 4) = "Owner"
objExcel.Cells(1, 5) = "Address2"
objExcel.Cells(1, 6) = "Address3"
objExcel.Cells(1, 7) = "Address4"
objExcel.Cells(1, 8) = "City"
objExcel.Cells(1, 9) = "State"
objExcel.Cells(1, 10) = "ZipCode"
intRow = 2 'Set first row to add data

' Create file system object
Set oFSO = CreateObject("Scripting.FileSystemObject")

' Read entire input file into a variable and close it
Set oInfile = oFSO.OpenTextFile(sInfile, ForReading, False, TriStateUseDefault)

Do While Not oInfile.AtEndOfStream
    sLine = oInfile.ReadLine
    Account = Trim(Mid(sLine, 1, 22))
    TYear = Trim(Mid(sLine, 23, 4))
    Over65 = Trim(Mid(sLine, 65, 1))
    Veteran = Trim(Mid(sLine, 66, 1))
    Disabled = Trim(Mid(sLine, 67, 1))
    DatePaid = Trim(Mid(sLine, 69, 8))
    LevyBalance = Trim(Mid(sLine, 87, 11))
    BankRupt = Trim(Mid(sLine, 139, 1))
    Owner = Trim(Mid(sLine, 202, 40))
    Address2 = Trim(Mid(sLine, 242, 40))
    Address3 = Trim(Mid(sLine, 282, 40))
    Address4 = Trim(Mid(sLine, 322, 40))
    City = Trim(Mid(sLine, 362, 24))
    State = Trim(Mid(sLine, 386, 2))
    ZipCode = Mid(sLine, 388, 5) & "-" & Mid(sLine, 393, 4)
           
    If (TYear <> "" And CLng(TYear) < 2010) And Over65 = "" And Veteran = "" And Disabled = "" And DatePaid = "" And ( LevyBalance <> "" And CLng(LevyBalance) >= 2500 ) And BankRupt = "" Then
        objExcel.Cells(intRow, 1) = Account
        objExcel.Cells(intRow, 2) = TYear
        objExcel.Cells(intRow, 3) = LevyBalance
        objExcel.Cells(intRow, 4) = Owner
        objExcel.Cells(intRow, 5) = Address2
        objExcel.Cells(intRow, 6) = Address3
        objExcel.Cells(intRow, 7) = Address4
        objExcel.Cells(intRow, 8) = City
        objExcel.Cells(intRow, 9) = State
        objExcel.Cells(intRow, 10) = ZipCode
        intRow = intRow + 1
    End If
Loop

'Duplicate Checking
For i = 2 To ActiveSheet.UsedRange.Rows.Count
doitagain:
Application.DisplayAlerts = False
If (Excel.WorksheetFunction.CountIf(Range("A2:A" & i), Range("A" & i)) > 1) Then
Rows(i).Delete
Application.DisplayAlerts = True
GoTo doitagain
End If
Next i

'Format and Sort Excel workbook

Set objSheet = objExcel.ActiveWorkbook.ActiveSheet
objSheet.Columns("A:A").NumberFormat = "0"
Set objRange = objSheet.UsedRange
objRange.EntireColumn.AutoFit()
For iW = objRange.Column To objRange.Columns.Count
    colWidth = objSheet.Columns(iW).ColumnWidth
    objSheet.Columns(iW).ColumnWidth = colWidth + 5
Next
	
'Save Excel Workbook
objExcel.ActiveWorkbook.SaveAs(sOutfile)
'objExcel.ActiveWorkbook.Close xlSaveChanges
'objExcel.Quit
WScript.Echo "Script Finished"

' Cleanup and end
oInfile.Close
Set oInfile = Nothing
Set oFSO = Nothing

Open in new window

i wanted the actual file you are having!! anyways, try this way, put my code in  a seperate procedure and run it once everything of your code is done..

i mean to say, run your code first
then run my code from a diff procedure... let's see!!
Avatar of jon1966

ASKER

Hi,

Please find the file attached.

J
act.zip
the following code works fine!!! check it out!!!


'Define needed constants
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
Const xlSaveChanges = 1 'Excel Save Changes
Const xlAscending = 1 'Excel Sort Ascending
Const xlDescending = 2 'Excel Sort Decending
Const xlYes = 1 'Excel Header Row Exists

cTab = Chr(9)

' Get input and output file names from command line parms
If (WScript.Arguments.Count > 0) Then
    sInfile = WScript.Arguments(0)
Else
    WScript.Echo "No input filename specified."
    WScript.Quit
End If
If (WScript.Arguments.Count > 1) Then
    sOutfile = WScript.Arguments(1)
Else
    WScript.Echo "No output filename specified."
    WScript.Quit
End If

'Create Excel Object
Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False 'Disable Overwrite Prompts
objExcel.Visible = True 'Hides Excel window

'Create Excel worksheet and add header row
objExcel.Workbooks.Add()
objExcel.Cells(1, 1) = "Account"
objExcel.Cells(1, 2) = "Year"
objExcel.Cells(1, 3) = "LevyBalance"
objExcel.Cells(1, 4) = "Owner"
objExcel.Cells(1, 5) = "Address2"
objExcel.Cells(1, 6) = "Address3"
objExcel.Cells(1, 7) = "Address4"
objExcel.Cells(1, 8) = "City"
objExcel.Cells(1, 9) = "State"
objExcel.Cells(1, 10) = "ZipCode"
intRow = 2 'Set first row to add data

' Create file system object
Set oFSO = CreateObject("Scripting.FileSystemObject")

' Read entire input file into a variable and close it
Set oInfile = oFSO.OpenTextFile(sInfile, ForReading, False, TriStateUseDefault)

Do While Not oInfile.AtEndOfStream
    sLine = oInfile.ReadLine
    Account = Trim(Mid(sLine, 1, 22))
    TYear = Trim(Mid(sLine, 23, 4))
    Over65 = Trim(Mid(sLine, 65, 1))
    Veteran = Trim(Mid(sLine, 66, 1))
    Disabled = Trim(Mid(sLine, 67, 1))
    DatePaid = Trim(Mid(sLine, 69, 8))
    LevyBalance = Trim(Mid(sLine, 87, 11))
    BankRupt = Trim(Mid(sLine, 139, 1))
    Owner = Trim(Mid(sLine, 202, 40))
    Address2 = Trim(Mid(sLine, 242, 40))
    Address3 = Trim(Mid(sLine, 282, 40))
    Address4 = Trim(Mid(sLine, 322, 40))
    City = Trim(Mid(sLine, 362, 24))
    State = Trim(Mid(sLine, 386, 2))
    ZipCode = Mid(sLine, 388, 5) & "-" & Mid(sLine, 393, 4)
           
    If (TYear <> "" And CLng(TYear) < 2010) And Over65 = "" And Veteran = "" And Disabled = "" And DatePaid = "" And ( LevyBalance <> "" And CLng(LevyBalance) >= 2500 ) And BankRupt = "" Then
        objExcel.Cells(intRow, 1) = Account
        objExcel.Cells(intRow, 2) = TYear
        objExcel.Cells(intRow, 3) = LevyBalance
        objExcel.Cells(intRow, 4) = Owner
        objExcel.Cells(intRow, 5) = Address2
        objExcel.Cells(intRow, 6) = Address3
        objExcel.Cells(intRow, 7) = Address4
        objExcel.Cells(intRow, 8) = City
        objExcel.Cells(intRow, 9) = State
        objExcel.Cells(intRow, 10) = ZipCode
        intRow = intRow + 1
    End If
Loop

'Duplicate Checking
Application.DisplayAlerts = False

set cur_cell=range("A2")

while cur_cell<>""

if(cur_cell=cur_cell.offset(-1,0))then
set cur_cell=cur_cell.offset(1,0)
cur_cell.offset(-1,0).EntireRow.Delete
else
set cur_cell=cur_cell.offset(1,0)
end if

wend

Application.DisplayAlerts = True

'Format and Sort Excel workbook

Set objSheet = objExcel.ActiveWorkbook.ActiveSheet
objSheet.Columns("A:A").NumberFormat = "0"
Set objRange = objSheet.UsedRange
objRange.EntireColumn.AutoFit()
For iW = objRange.Column To objRange.Columns.Count
    colWidth = objSheet.Columns(iW).ColumnWidth
    objSheet.Columns(iW).ColumnWidth = colWidth + 5
Next
      
'Save Excel Workbook
objExcel.ActiveWorkbook.SaveAs(sOutfile)
'objExcel.ActiveWorkbook.Close xlSaveChanges
'objExcel.Quit
WScript.Echo "Script Finished"

' Cleanup and end
oInfile.Close
Set oInfile = Nothing
Set oFSO = Nothing
Avatar of jon1966

ASKER

NO.  It does not.  I just pasted your code into a new file and ran.

4-23-2011-12-04-58-PM.jpg
hey, the following code works fine:
but before the duplicates are removed, the data should be sorted by the first column!
I most of the times work on Excel VBA and there are few differences between VBA and VBScript. Hence my sort code is not working. You please modify it accordingly and can use it. I have disabled the sort code. You can use that. I am attaching the screen when i saw the script got over. let me know if you have any questions.

'Define needed constants
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
Const xlSaveChanges = 1 'Excel Save Changes
Const xlAscending = 1 'Excel Sort Ascending
Const xlDescending = 2 'Excel Sort Decending
Const xlYes = 1 'Excel Header Row Exists

cTab = Chr(9)

' Get input and output file names from command line parms
If (WScript.Arguments.Count > 0) Then
    sInfile = WScript.Arguments(0)
Else
    WScript.Echo "No input filename specified."
    WScript.Quit
End If
If (WScript.Arguments.Count > 1) Then
    sOutfile = WScript.Arguments(1)
Else
    WScript.Echo "No output filename specified."
    WScript.Quit
End If

'Create Excel Object
Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False 'Disable Overwrite Prompts
objExcel.Visible = True 'Hides Excel window

'Create Excel worksheet and add header row
objExcel.Workbooks.Add()
objExcel.Cells(1, 1) = "Account"
objExcel.Cells(1, 2) = "Year"
objExcel.Cells(1, 3) = "LevyBalance"
objExcel.Cells(1, 4) = "Owner"
objExcel.Cells(1, 5) = "Address2"
objExcel.Cells(1, 6) = "Address3"
objExcel.Cells(1, 7) = "Address4"
objExcel.Cells(1, 8) = "City"
objExcel.Cells(1, 9) = "State"
objExcel.Cells(1, 10) = "ZipCode"
intRow = 2 'Set first row to add data

' Create file system object
Set oFSO = CreateObject("Scripting.FileSystemObject")

' Read entire input file into a variable and close it
Set oInfile = oFSO.OpenTextFile(sInfile, ForReading, False, TriStateUseDefault)

Do While Not oInfile.AtEndOfStream
    sLine = oInfile.ReadLine
    Account = Trim(Mid(sLine, 1, 22))
    TYear = Trim(Mid(sLine, 23, 4))
    Over65 = Trim(Mid(sLine, 65, 1))
    Veteran = Trim(Mid(sLine, 66, 1))
    Disabled = Trim(Mid(sLine, 67, 1))
    DatePaid = Trim(Mid(sLine, 69, 8))
    LevyBalance = Trim(Mid(sLine, 87, 11))
    BankRupt = Trim(Mid(sLine, 139, 1))
    Owner = Trim(Mid(sLine, 202, 40))
    Address2 = Trim(Mid(sLine, 242, 40))
    Address3 = Trim(Mid(sLine, 282, 40))
    Address4 = Trim(Mid(sLine, 322, 40))
    City = Trim(Mid(sLine, 362, 24))
    State = Trim(Mid(sLine, 386, 2))
    ZipCode = Mid(sLine, 388, 5) & "-" & Mid(sLine, 393, 4)
           
    If (TYear <> "" And CLng(TYear) < 2010) And Over65 = "" And Veteran = "" And Disabled = "" And DatePaid = "" And ( LevyBalance <> "" And CLng(LevyBalance) >= 2500 ) And BankRupt = "" Then
        objExcel.Cells(intRow, 1) = Account
        objExcel.Cells(intRow, 2) = TYear
        objExcel.Cells(intRow, 3) = LevyBalance
        objExcel.Cells(intRow, 4) = Owner
        objExcel.Cells(intRow, 5) = Address2
        objExcel.Cells(intRow, 6) = Address3
        objExcel.Cells(intRow, 7) = Address4
        objExcel.Cells(intRow, 8) = City
        objExcel.Cells(intRow, 9) = State
        objExcel.Cells(intRow, 10) = ZipCode
        intRow = intRow + 1
    End If
Loop

'Format and Sort Excel workbook

Set objSheet = objExcel.ActiveWorkbook.ActiveSheet
objSheet.Columns("A:A").NumberFormat = "0"
Set objRange = objSheet.UsedRange
objRange.EntireColumn.AutoFit()
For iW = objRange.Column To objRange.Columns.Count
    colWidth = objSheet.Columns(iW).ColumnWidth
    objSheet.Columns(iW).ColumnWidth = colWidth + 5
Next
      
'Save Excel Workbook
objExcel.ActiveWorkbook.SaveAs(sOutfile)

'
'objSheet.Sort.SortFields.Clear
'    objSheet.Sort.SortFields.Add Key = objSheet.Range("A:A"), SortOn = xlSortOnValues, Order = xlAscending, DataOption = xlSortNormal
'    With objSheet.Sort
'        .SetRange objSheet.Range("A:J")
'        .Header = xlYes
'        .MatchCase = False
'        .Orientation = xlTopToBottom
'        .SortMethod = xlPinYin
'        .Apply
'    End With
'




'Duplicate Checking

set cur_cell=objSheet.range("A2")

while cur_cell<>""

if(cur_cell=cur_cell.offset(-1,0))then
set cur_cell=cur_cell.offset(1,0)
cur_cell.offset(-1,0).EntireRow.Delete
else
set cur_cell=cur_cell.offset(1,0)
end if

wend



'objExcel.ActiveWorkbook.Close xlSaveChanges
'objExcel.Quit
WScript.Echo "Script Finished"

' Cleanup and end
oInfile.Close
Set oInfile = Nothing
Set oFSO = Nothing
Picture1.png
ASKER CERTIFIED SOLUTION
Avatar of jon1966
jon1966
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
yea, that's what i had asked u.. u should sort it before my new code.. so, the place where i have disabled the code for sorting, please make it work.. as i am pretty busy with other things.. it should work.. if you are not able to do, let me know...
Avatar of jon1966

ASKER

Thanks for the help balatheexpert, unfortunately your code does not work.  The single question at hand was to take an existing script and added duplicate removal functionality.  Thanks for your time.
okay cool!!!
Avatar of jon1966

ASKER

balatheexpert  code does not work.  The code provided does the same functions as when I asked the question so no new added functionality exists.  I've reverted back to the code as when I started.