VBA Help! (Parsing Excel File into .dat)

londoneye001 · Sep 16, 2015

Hi,

I was wondering if someone can help me with a VBA code. Basically a macro was created on the original file to parse the information into a .dat file. The information is sensitive so I cannot post it here but I can provide you the coding behind it.

Issue: Issue here is, due to some system changes columns have moved hence VBA code need to reflect that.

Old File Headings: Column A to Y

SIN

XCode

LastName

FirstName

Address

Address2

City

Desc1

idProvState

Postal

Phone

BirthDate

idMarital

Gender

Field2

idPayStatus

OrigHireDate

eeEEnum

LangPref

TerminatedDate

FedTaxClaim

NormalHours

ProvTaxClaim

Field8

eeERnum

New File Headings: Column A to BN

SIN

Record Identifier

Department 1

Department 2

Last Name

First Name

Address

City

Province

Postal Code

Phone Number 1

Birthdate

Marital

Gender

Position

Status

Employment Date

Employee No

Base Yearly Rate

Custom Text

Effective Date

Language

Termination Date

TotFedTD1

Total Prov TD1

Seniority Date

Effective Date

Name

HomePh

Comm

Job Status

Email

Additional Information: On the new file column D & E is a concatenate which is column B (X Code) old file heading.

What I need to Parse from new file is:

1. SIN
2. Record Identifier
3. Concatenate of Department 1 & 2
4. Last Name
5. First Name
6. Address
7. Concatenate of City Name & Province
8. Postal Code
9. Phone Number
10. Date of Birth
11. Marital Status
12. Gender
11. Position

plus 6 other columns, which at this stage i'm not sure but please select any column and highlight in the code so that i can change the column name or number, etc.

Code is:

Sub Parklane()
'
' Parklane Macro
' Macro recorded 08/16/2007 by Abele Martin
' To creat fixed width file for parklane import
'
PageName = "\\hr\Parklane\HS\PARKLANE" & ".DAT"
FirstRow = Range("C1").Value
LastRow = Range("C2").Value

Open PageName For Output As #1
For MyRow = FirstRow To LastRow
MyStr = "" 'clear valiable
If Val(Cells(MyRow, 1).Value) > 99999999 And Val(Cells(MyRow, 1).Value) < 999999999 Then 'SIN
MyStr = MyStr & Val(Cells(MyRow, 1).Value)
Else
MyStr = MyStr & Left(Trim(Cells(MyRow, 1).Value) & String(9, " "), 9)
End If
MyStr = MyStr & "#" 'Record Identifier
MyStr = MyStr & Left(Cells(MyRow, 2).Value & String(10, " "), 10) 'Department
MyStr = MyStr & Left(Cells(MyRow, 3).Value & String(25, " "), 25) 'LastName
MyStr = MyStr & Left(Cells(MyRow, 4).Value & String(20, " "), 20) 'FirstName
MyStr = MyStr & Left(Cells(MyRow, 5).Value & " " & Cells(MyRow, 6).Value & String(30, " "), 30) 'Combine Address & Address2 and Trim to Char 30
MyStr = MyStr & Left(Cells(MyRow, 8).Value & ", " & Cells(MyRow, 9).Value & String(30, " "), 30) 'City
MyStr = MyStr & Left(Cells(MyRow, 10).Value & String(7, " "), 7) 'PostalCode
If Val(Mid(Cells(MyRow, 11).Value, 2, 3) & Right(Cells(MyRow, 11).Value, 8)) > 999999999 Then 'AreaCode & Phone
MyStr = MyStr & Val(Mid(Cells(MyRow, 11).Value, 2, 3) & Right(Cells(MyRow, 11).Value, 8))
Else
MyStr = MyStr & String(10, " ")
End If
MyStr = MyStr & Left(Format(Cells(MyRow, 12).Value, "ddmmyyyy") & String(8, " "), 8) 'BirthDate
If Cells(MyRow, 13).Value = "S" _
Or Cells(MyRow, 13).Value = "M" _
Or Cells(MyRow, 13).Value = "D" _
Or Cells(MyRow, 13).Value = "W" _
Or Cells(MyRow, 13).Value = "C" Then 'MaritalStatus
MyStr = MyStr & Cells(MyRow, 13).Value
ElseIf Cells(MyRow, 13).Value = "L" Then
MyStr = MyStr & "X"
Else
MyStr = MyStr & " "
End If
If Cells(MyRow, 14).Value = "M" Or Cells(MyRow, 14).Value = "F" Then 'Gender
MyStr = MyStr & Left(Cells(MyRow, 14).Value & String(1, " "), 1)
Else
MyStr = MyStr & " "
End If
MyStr = MyStr & Left(Cells(MyRow, 15).Value & String(24, " "), 24) 'JobTitle
If Cells(MyRow, 16).Value = "A" Then 'Status
Select Case Cells(MyRow, 24).Value
Case "FT"
MyStr = MyStr & "F"
Case "TFT"
MyStr = MyStr & "E"
Case "PT"
MyStr = MyStr & "P"
Case "TPT"
MyStr = MyStr & "E"
Case "SEA"
MyStr = MyStr & "E"
Case "N/A"
MyStr = MyStr & "F"
Case Else
MyStr = MyStr & "E"
End Select
ElseIf Cells(MyRow, 16).Value = "L" Then
MyStr = MyStr & "A"
ElseIf Cells(MyRow, 16).Value = "T" Then
MyStr = MyStr & "T"
Else: MyStr = MyStr & "E"
End If
MyStr = MyStr & Left(Format(Cells(MyRow, 17).Value, "ddmmyyyy") & String(8, " "), 8) 'Employment Date
MyStr = MyStr & String(4, " ") 'StartOfShift
MyStr = MyStr & String(4, " ") 'EndOfShift
MyStr = MyStr & String(8, " ") 'LongTermDis
MyStr = MyStr & String(8, " ") 'LeaveOfAbsStrart
MyStr = MyStr & String(8, " ") 'LeaveOfAbsStop
MyStr = MyStr & String(8, " ") 'MaternityDelDate
MyStr = MyStr & String(8, " ") 'MaternityStart
MyStr = MyStr & String(8, " ") 'MaternityStop
MyStr = MyStr & Right(String(9, " ") & Cells(MyRow, 25).Value & Right(Cells(MyRow, 18).Value, 5), 9) 'EmployeeNum
MyStr = MyStr & String(12, " ") 'HealthInsur
MyStr = MyStr & String(2, " ") 'YearsExper
MyStr = MyStr & String(8, " ") 'Salary
MyStr = MyStr & String(1, " ") 'SalaryType
MyStr = MyStr & String(8, " ") 'SalaryDate
MyStr = MyStr & Left(Cells(MyRow, 19).Value & String(1, " "), 1) 'Language
MyStr = MyStr & String(25, " ") 'Misc
MyStr = MyStr & String(20, " ") 'Union
MyStr = MyStr & Left(Format(Cells(MyRow, 20).Value, "ddmmyyyy") & String(8, " "), 8) 'TermDate
MyStr = MyStr & Right(String(5, " ") & Val(Cells(MyRow, 21).Value), 5) 'TD1ExempFed
MyStr = MyStr & String(2, " ") 'TD1ExempCDFed
MyStr = MyStr & String(4, " ") 'HoursWorkedDay
If Val(Cells(MyRow, 22).Value) > 60 Then 'HoursWorkedWeek
MyStr = MyStr & Left((Fix(Val(Cells(MyRow, 22).Value) / 2) & _
Fix(((Val(Cells(MyRow, 22).Value) / 2) - (Fix(Val(Cells(MyRow, 22).Value) / 2))) * 60)) & String(4, "0"), 4)
ElseIf Val(Cells(MyRow, 22).Value) > 0 And Val(Cells(MyRow, 22).Value) < 60 Then
MyStr = MyStr & Left((Fix(Val(Cells(MyRow, 22).Value)) & _
(Val(Cells(MyRow, 22).Value) - Fix(Val(Cells(MyRow, 22).Value))) * 60) & String(4, "0"), 4)
Else
MyStr = MyStr & String(4, " ")
End If
MyStr = MyStr & Right(String(5, " ") & Val(Cells(MyRow, 23).Value), 5) 'TD1ExempProv
MyStr = MyStr & String(2, " ") 'TD1ExempCDProv
MyStr = MyStr & String(1, " ") 'MultiLoc
MyStr = MyStr & String(25, " ") 'AlterLocation
MyStr = MyStr & String(25, " ") 'AlterLocationSec
MyStr = MyStr & String(20, " ") 'Country2
MyStr = MyStr & String(20, " ") 'ZipCode
MyStr = MyStr & String(25, " ") 'ForeignPhone

Print #1, MyStr
Next
Close #1
'
End Sub

Appreciate your help! Thanks,

ranman256 · Sep 16, 2015

tho you couldnt post the original data, we need to see the data layout for what you are starting with.
make up some sample data.

londoneye001 · Sep 16, 2015

ranman256 said:
tho you couldnt post the original data, we need to see the data layout for what you are starting with.
make up some sample data.

Hi Ran - thanks. Here is a sample data based on the old file! Hope this helps! Thanks

SIN

XCode

LastName

FirstName

Address

Address2

City

Desc1

idProvState

Postal

Phone

BirthDate

idMarital

Gender

Field2

idPayStatus

OrigHireDate

eeEEnum

LangPref

TerminatedDate

FedTaxClaim

NormalHours

ProvTaxClaim

Field8

eeERnum

123456

800920

Smith

John

12345 Oxford Street

Hamilton

ON

A1B 8A4

(123) 456 7890

13/01/1965 0:00

M

Clearning

T

08/07/2009 0:00

000008011

E

01/01/2015 0:00

11067

80

1234

FT

0123

ranman256 · Sep 16, 2015

where's the problem? it looks like you are scanning the table and assembling the output line.
is it failing?

Code:

Sub Macro1()
Filename = "\\hr\Parklane\HS\PARKLANE" & ".DAT"


FirstRow = Range("C1").Value
LastRow = Range("C2").Value


Open Filename For Output As #1
For MyRow = FirstRow To LastRow
    MyStr = "" 'clear valiable
    If Val(Cells(MyRow, 1).Value) > 99999999 And Val(Cells(MyRow, 1).Value) < 999999999 Then 'SIN
       MyStr = MyStr & Val(Cells(MyRow, 1).Value)
    Else
        MyStr = MyStr & Left(Trim(Cells(MyRow, 1).Value) & String(9, " "), 9)
    End If
    
    MyStr = MyStr & "#" 'Record Identifier
    MyStr = MyStr & Left(Cells(MyRow, 2).Value & String(10, " "), 10) 'Department
    MyStr = MyStr & Left(Cells(MyRow, 3).Value & String(25, " "), 25) 'LastName
    MyStr = MyStr & Left(Cells(MyRow, 4).Value & String(20, " "), 20) 'FirstName
    MyStr = MyStr & Left(Cells(MyRow, 5).Value & " " & Cells(MyRow, 6).Value & String(30, " "), 30) 'Combine Address & Address2 and Trim to Char 30
    MyStr = MyStr & Left(Cells(MyRow, 8).Value & ", " & Cells(MyRow, 9).Value & String(30, " "), 30) 'City
    MyStr = MyStr & Left(Cells(MyRow, 10).Value & String(7, " "), 7) 'PostalCode
    
    If Val(Mid(Cells(MyRow, 11).Value, 2, 3) & Right(Cells(MyRow, 11).Value, 8)) > 999999999 Then 'AreaCode & Phone
        MyStr = MyStr & Val(Mid(Cells(MyRow, 11).Value, 2, 3) & Right(Cells(MyRow, 11).Value, 8))
    Else
        MyStr = MyStr & String(10, " ")
    End If
    
    MyStr = MyStr & Left(Format(Cells(MyRow, 12).Value, "ddmmyyyy") & String(8, " "), 8) 'BirthDate
    
    Select Case Cells(MyRow, 13).Value    'MaritalStatus
      Case "S", "M", "D", "W", "C"
          MyStr = MyStr & Cells(MyRow, 13).Value
      Case "L"
          MyStr = MyStr & "X"
      Case Else
         MyStr = MyStr & " "
    End Select
    
    If Cells(MyRow, 14).Value = "M" Or Cells(MyRow, 14).Value = "F" Then 'Gender
        MyStr = MyStr & Left(Cells(MyRow, 14).Value & String(1, " "), 1)
    Else
        MyStr = MyStr & " "
    End If
    
    MyStr = MyStr & Left(Cells(MyRow, 15).Value & String(24, " "), 24) 'JobTitle
    
    Select Case Cells(MyRow, 16).Value   'status
       Case "A"
        Select Case Cells(MyRow, 24).Value
            Case "FT"
                MyStr = MyStr & "F"
            Case "TFT"
                MyStr = MyStr & "E"
            Case "PT"
                MyStr = MyStr & "P"
            Case "TPT"
                MyStr = MyStr & "E"
            Case "SEA"
                MyStr = MyStr & "E"
            Case "N/A"
                MyStr = MyStr & "F"
            Case Else
                MyStr = MyStr & "E"
         End Select
     Case "L"
         MyStr = MyStr & "A"
      Case "T"
        MyStr = MyStr & "T"
    Case Else
        MyStr = MyStr & "E"
    End Select
    
    
    MyStr = MyStr & Left(Format(Cells(MyRow, 17).Value, "ddmmyyyy") & String(8, " "), 8) 'Employment Date
    MyStr = MyStr & String(4, " ") 'StartOfShift
    MyStr = MyStr & String(4, " ") 'EndOfShift
    MyStr = MyStr & String(8, " ") 'LongTermDis
    MyStr = MyStr & String(8, " ") 'LeaveOfAbsStrart
    MyStr = MyStr & String(8, " ") 'LeaveOfAbsStop
    MyStr = MyStr & String(8, " ") 'MaternityDelDate
    MyStr = MyStr & String(8, " ") 'MaternityStart
    MyStr = MyStr & String(8, " ") 'MaternityStop
    MyStr = MyStr & Right(String(9, " ") & Cells(MyRow, 25).Value & Right(Cells(MyRow, 18).Value, 5), 9) 'EmployeeNum
    MyStr = MyStr & String(12, " ") 'HealthInsur
    MyStr = MyStr & String(2, " ") 'YearsExper
    MyStr = MyStr & String(8, " ") 'Salary
    MyStr = MyStr & String(1, " ") 'SalaryType
    MyStr = MyStr & String(8, " ") 'SalaryDate
    MyStr = MyStr & Left(Cells(MyRow, 19).Value & String(1, " "), 1) 'Language
    MyStr = MyStr & String(25, " ") 'Misc
    MyStr = MyStr & String(20, " ") 'Union
    MyStr = MyStr & Left(Format(Cells(MyRow, 20).Value, "ddmmyyyy") & String(8, " "), 8) 'TermDate
    MyStr = MyStr & Right(String(5, " ") & Val(Cells(MyRow, 21).Value), 5) 'TD1ExempFed
    MyStr = MyStr & String(2, " ") 'TD1ExempCDFed
    MyStr = MyStr & String(4, " ") 'HoursWorkedDay
    
    If Val(Cells(MyRow, 22).Value) > 60 Then 'HoursWorkedWeek
        MyStr = MyStr & Left((Fix(Val(Cells(MyRow, 22).Value) / 2) & _
        Fix(((Val(Cells(MyRow, 22).Value) / 2) - (Fix(Val(Cells(MyRow, 22).Value) / 2))) * 60)) & String(4, "0"), 4)
    ElseIf Val(Cells(MyRow, 22).Value) > 0 And Val(Cells(MyRow, 22).Value) < 60 Then
        MyStr = MyStr & Left((Fix(Val(Cells(MyRow, 22).Value)) & (Val(Cells(MyRow, 22).Value) - Fix(Val(Cells(MyRow, 22).Value))) * 60) & String(4, "0"), 4)
    Else
        MyStr = MyStr & String(4, " ")
    End If
    
    MyStr = MyStr & Right(String(5, " ") & Val(Cells(MyRow, 23).Value), 5) 'TD1ExempProv
    MyStr = MyStr & String(2, " ") 'TD1ExempCDProv
    MyStr = MyStr & String(1, " ") 'MultiLoc
    MyStr = MyStr & String(25, " ") 'AlterLocation
    MyStr = MyStr & String(25, " ") 'AlterLocationSec
    MyStr = MyStr & String(20, " ") 'Country2
    MyStr = MyStr & String(20, " ") 'ZipCode
    MyStr = MyStr & String(25, " ") 'ForeignPhone
    
    Print #1, MyStr
Next
Close #1
End Sub

londoneye001 · Sep 16, 2015

ranman256 said:

where's the problem? it looks like you are scanning the table and assembling the output line.
is it failing?

Code:

Sub Macro1()
Filename = "\\hr\Parklane\HS\PARKLANE" & ".DAT"


FirstRow = Range("C1").Value
LastRow = Range("C2").Value


Open Filename For Output As #1
For MyRow = FirstRow To LastRow
    MyStr = "" 'clear valiable
    If Val(Cells(MyRow, 1).Value) > 99999999 And Val(Cells(MyRow, 1).Value) < 999999999 Then 'SIN
       MyStr = MyStr & Val(Cells(MyRow, 1).Value)
    Else
        MyStr = MyStr & Left(Trim(Cells(MyRow, 1).Value) & String(9, " "), 9)
    End If
    
    MyStr = MyStr & "#" 'Record Identifier
    MyStr = MyStr & Left(Cells(MyRow, 2).Value & String(10, " "), 10) 'Department
    MyStr = MyStr & Left(Cells(MyRow, 3).Value & String(25, " "), 25) 'LastName
    MyStr = MyStr & Left(Cells(MyRow, 4).Value & String(20, " "), 20) 'FirstName
    MyStr = MyStr & Left(Cells(MyRow, 5).Value & " " & Cells(MyRow, 6).Value & String(30, " "), 30) 'Combine Address & Address2 and Trim to Char 30
    MyStr = MyStr & Left(Cells(MyRow, 8).Value & ", " & Cells(MyRow, 9).Value & String(30, " "), 30) 'City
    MyStr = MyStr & Left(Cells(MyRow, 10).Value & String(7, " "), 7) 'PostalCode
    
    If Val(Mid(Cells(MyRow, 11).Value, 2, 3) & Right(Cells(MyRow, 11).Value, 8)) > 999999999 Then 'AreaCode & Phone
        MyStr = MyStr & Val(Mid(Cells(MyRow, 11).Value, 2, 3) & Right(Cells(MyRow, 11).Value, 8))
    Else
        MyStr = MyStr & String(10, " ")
    End If
    
    MyStr = MyStr & Left(Format(Cells(MyRow, 12).Value, "ddmmyyyy") & String(8, " "), 8) 'BirthDate
    
    Select Case Cells(MyRow, 13).Value    'MaritalStatus
      Case "S", "M", "D", "W", "C"
          MyStr = MyStr & Cells(MyRow, 13).Value
      Case "L"
          MyStr = MyStr & "X"
      Case Else
         MyStr = MyStr & " "
    End Select
    
    If Cells(MyRow, 14).Value = "M" Or Cells(MyRow, 14).Value = "F" Then 'Gender
        MyStr = MyStr & Left(Cells(MyRow, 14).Value & String(1, " "), 1)
    Else
        MyStr = MyStr & " "
    End If
    
    MyStr = MyStr & Left(Cells(MyRow, 15).Value & String(24, " "), 24) 'JobTitle
    
    Select Case Cells(MyRow, 16).Value   'status
       Case "A"
        Select Case Cells(MyRow, 24).Value
            Case "FT"
                MyStr = MyStr & "F"
            Case "TFT"
                MyStr = MyStr & "E"
            Case "PT"
                MyStr = MyStr & "P"
            Case "TPT"
                MyStr = MyStr & "E"
            Case "SEA"
                MyStr = MyStr & "E"
            Case "N/A"
                MyStr = MyStr & "F"
            Case Else
                MyStr = MyStr & "E"
         End Select
     Case "L"
         MyStr = MyStr & "A"
      Case "T"
        MyStr = MyStr & "T"
    Case Else
        MyStr = MyStr & "E"
    End Select
    
    
    MyStr = MyStr & Left(Format(Cells(MyRow, 17).Value, "ddmmyyyy") & String(8, " "), 8) 'Employment Date
    MyStr = MyStr & String(4, " ") 'StartOfShift
    MyStr = MyStr & String(4, " ") 'EndOfShift
    MyStr = MyStr & String(8, " ") 'LongTermDis
    MyStr = MyStr & String(8, " ") 'LeaveOfAbsStrart
    MyStr = MyStr & String(8, " ") 'LeaveOfAbsStop
    MyStr = MyStr & String(8, " ") 'MaternityDelDate
    MyStr = MyStr & String(8, " ") 'MaternityStart
    MyStr = MyStr & String(8, " ") 'MaternityStop
    MyStr = MyStr & Right(String(9, " ") & Cells(MyRow, 25).Value & Right(Cells(MyRow, 18).Value, 5), 9) 'EmployeeNum
    MyStr = MyStr & String(12, " ") 'HealthInsur
    MyStr = MyStr & String(2, " ") 'YearsExper
    MyStr = MyStr & String(8, " ") 'Salary
    MyStr = MyStr & String(1, " ") 'SalaryType
    MyStr = MyStr & String(8, " ") 'SalaryDate
    MyStr = MyStr & Left(Cells(MyRow, 19).Value & String(1, " "), 1) 'Language
    MyStr = MyStr & String(25, " ") 'Misc
    MyStr = MyStr & String(20, " ") 'Union
    MyStr = MyStr & Left(Format(Cells(MyRow, 20).Value, "ddmmyyyy") & String(8, " "), 8) 'TermDate
    MyStr = MyStr & Right(String(5, " ") & Val(Cells(MyRow, 21).Value), 5) 'TD1ExempFed
    MyStr = MyStr & String(2, " ") 'TD1ExempCDFed
    MyStr = MyStr & String(4, " ") 'HoursWorkedDay
    
    If Val(Cells(MyRow, 22).Value) > 60 Then 'HoursWorkedWeek
        MyStr = MyStr & Left((Fix(Val(Cells(MyRow, 22).Value) / 2) & _
        Fix(((Val(Cells(MyRow, 22).Value) / 2) - (Fix(Val(Cells(MyRow, 22).Value) / 2))) * 60)) & String(4, "0"), 4)
    ElseIf Val(Cells(MyRow, 22).Value) > 0 And Val(Cells(MyRow, 22).Value) < 60 Then
        MyStr = MyStr & Left((Fix(Val(Cells(MyRow, 22).Value)) & (Val(Cells(MyRow, 22).Value) - Fix(Val(Cells(MyRow, 22).Value))) * 60) & String(4, "0"), 4)
    Else
        MyStr = MyStr & String(4, " ")
    End If
    
    MyStr = MyStr & Right(String(5, " ") & Val(Cells(MyRow, 23).Value), 5) 'TD1ExempProv
    MyStr = MyStr & String(2, " ") 'TD1ExempCDProv
    MyStr = MyStr & String(1, " ") 'MultiLoc
    MyStr = MyStr & String(25, " ") 'AlterLocation
    MyStr = MyStr & String(25, " ") 'AlterLocationSec
    MyStr = MyStr & String(20, " ") 'Country2
    MyStr = MyStr & String(20, " ") 'ZipCode
    MyStr = MyStr & String(25, " ") 'ForeignPhone
    
    Print #1, MyStr
Next
Close #1
End Sub

Ran - its not failing. This is based on old output file. Now we have had system change and new output columns is different. I need to replace old columns with new but i don't know VBA at all and needed that help. New columns are follows:

SIN

Record Identifier

Department 1

Department 2

Last Name

First Name

Address

City

Province

Postal Code

Phone Number 1

Birthdate

Marital

Gender

Position

Status

Employment Date

Employee No

Base Yearly Rate

Custom Text

Effective Date

Language

Termination Date

TotFedTD1

Total Prov TD1

Seniority Date

Effective Date

Name

HomePh

Comm

ranman256 · Sep 16, 2015

cant you just re-arrange the columns on the grid, then save as text file , file.Dat.
(including your calculated fields)
thus no need for vb code.

VBA Help! (Parsing Excel File into .dat)

londoneye001

Board Regular

Excel Facts

ranman256

Well-known Member

londoneye001

Board Regular

ranman256

Well-known Member

londoneye001

Board Regular

ranman256

Well-known Member

Similar threads

Forum statistics

Share this page

VBA Help! (Parsing Excel File into .dat)

londoneye001

Board Regular

Excel Facts

ranman256

Well-known Member

londoneye001

Board Regular

ranman256

Well-known Member

londoneye001

Board Regular

ranman256

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock