Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35
Default Fix this Code?

Hi,

Can someone please help to fix & improve this code? Data files below with
two questions:

Option Explicit
Type RecordIn
AccNo As String * 3
Com1 As String * 1
TrxName As String * 4
Com2 As String * 1
EffDate As String * 10
LineFeed As String * 2
End Type

Type RecordOut
AccNo As String * 3
TrxName As String * 4
EffDate As String * 10
Ind As String * 3
LineFeed As String * 2
End Type

Sub Button3_Click()
Dim MyRecIn As RecordIn
Dim MyRecOut As RecordOut
Dim f As Integer
Dim g As Integer
Dim CurrAcc As String
Dim CurrTrx As String
Dim CurrDt As String
Dim OutAcc As String
Dim OutTrx As String
Dim OutDt As String
Dim OutInd As String

Dim OutAcc1 As String
Dim OutTrx1 As String
Dim OutDt1 As String

Dim i As Integer
Dim r As Long
f = FreeFile
g = FreeFile


Open "c:\hil\inpn.txt" For Random As #f Len = Len(MyRecIn)
g = FreeFile
Open "c:\hil\out.txt" For Random As #g Len = Len(MyRecOut)

r = 0

Do Until EOF(f)
r = r + 1
Get #f, r, MyRecIn
CurrAcc = MyRecIn.AccNo
CurrTrx = MyRecIn.TrxName
CurrDt = MyRecIn.EffDate
Do Until MyRecIn.AccNo < CurrAcc
Get #f, r, MyRecIn
MyRecOut.AccNo = MyRecIn.AccNo
MyRecOut.TrxName = MyRecIn.TrxName
MyRecOut.EffDate = MyRecIn.EffDate
MyRecOut.Ind = MyRecIn.TrxName
Put #g, r, MyRecOut
OutAcc = MyRecOut.AccNo
OutTrx = MyRecOut.TrxName
OutDt = MyRecOut.EffDate
OutInd = MyRecOut.Ind
r = r + 1
Loop

r = r - 2
Get #f, r, MyRecIn
OutAcc1 = MyRecIn.AccNo
OutTrx1 = MyRecIn.TrxName
OutDt1 = MyRecIn.EffDate

If MyRecIn.TrxName < "Curr" Then
MyRecOut.AccNo = MyRecIn.AccNo
MyRecOut.TrxName = MyRecIn.TrxName
MyRecOut.EffDate = MyRecIn.EffDate
MyRecOut.Ind = "Off"
Put #g, r, MyRecOut
End If

Loop

Close #f
Close #g
MsgBox ("End of Run")
End Sub


Input file:
001,Prev,31/12/2003
001,Curr,31/12/2004
002,Prev,31/12/2003
002,PI ,01/01/2004
003,Prev,31/12/2004


Output file:
001Prev31/12/2003Pre
001Curr31/12/2004Cur
002Prev31/12/2003Pre
002PI 01/01/2004Off
003Prev31/12/2004Off *

* The last record is incorrect - should show "Pre". There is also an extra
output "record" just made up of spaces - ends where the asterisk is. This
must not appear. Would also like commas between the output data fields.

Thanks

Hilton


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 176
Default Fix this Code?

On my XL97, the below gives f=1 and g=1.
f = FreeFile
g = FreeFile

So you probably want
f = FreeFile
Open ..As #f ..
g = FreeFile
..
Would also like commas between the output data fields

How about just
MyRecOut.AccNo = MyRecIn.AccNo & ","

Hilton wrote:
Can someone please help to fix & improve this code? Data files below with
two questions:

Option Explicit
Type RecordIn
AccNo As String * 3
Com1 As String * 1
TrxName As String * 4
Com2 As String * 1
EffDate As String * 10
LineFeed As String * 2
End Type

Type RecordOut
AccNo As String * 3
TrxName As String * 4
EffDate As String * 10
Ind As String * 3
LineFeed As String * 2
End Type

Sub Button3_Click()
Dim MyRecIn As RecordIn
Dim MyRecOut As RecordOut
Dim f As Integer
Dim g As Integer
Dim CurrAcc As String
Dim CurrTrx As String
Dim CurrDt As String
Dim OutAcc As String
Dim OutTrx As String
Dim OutDt As String
Dim OutInd As String

Dim OutAcc1 As String
Dim OutTrx1 As String
Dim OutDt1 As String

Dim i As Integer
Dim r As Long
f = FreeFile
g = FreeFile


Open "c:\hil\inpn.txt" For Random As #f Len = Len(MyRecIn)
g = FreeFile
Open "c:\hil\out.txt" For Random As #g Len = Len(MyRecOut)

r = 0

Do Until EOF(f)
r = r + 1
Get #f, r, MyRecIn
CurrAcc = MyRecIn.AccNo
CurrTrx = MyRecIn.TrxName
CurrDt = MyRecIn.EffDate
Do Until MyRecIn.AccNo < CurrAcc
Get #f, r, MyRecIn
MyRecOut.AccNo = MyRecIn.AccNo
MyRecOut.TrxName = MyRecIn.TrxName
MyRecOut.EffDate = MyRecIn.EffDate
MyRecOut.Ind = MyRecIn.TrxName
Put #g, r, MyRecOut
OutAcc = MyRecOut.AccNo
OutTrx = MyRecOut.TrxName
OutDt = MyRecOut.EffDate
OutInd = MyRecOut.Ind
r = r + 1
Loop

r = r - 2
Get #f, r, MyRecIn
OutAcc1 = MyRecIn.AccNo
OutTrx1 = MyRecIn.TrxName
OutDt1 = MyRecIn.EffDate

If MyRecIn.TrxName < "Curr" Then
MyRecOut.AccNo = MyRecIn.AccNo
MyRecOut.TrxName = MyRecIn.TrxName
MyRecOut.EffDate = MyRecIn.EffDate
MyRecOut.Ind = "Off"
Put #g, r, MyRecOut
End If

Loop

Close #f
Close #g
MsgBox ("End of Run")
End Sub


Input file:
001,Prev,31/12/2003
001,Curr,31/12/2004
002,Prev,31/12/2003
002,PI ,01/01/2004
003,Prev,31/12/2004


Output file:
001Prev31/12/2003Pre
001Curr31/12/2004Cur
002Prev31/12/2003Pre
002PI 01/01/2004Off
003Prev31/12/2004Off *

* The last record is incorrect - should show "Pre". There is also an extra
output "record" just made up of spaces - ends where the asterisk is. This
must not appear. Would also like commas between the output data fields.

Thanks

Hilton


  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 863
Default Fix this Code?

Yes, FREEFILE returns the next available file number. Until you open a file
using F, it's still free.

On Sat, 22 Jan 2005 20:25:54 -0800, Dave D-C wrote:

On my XL97, the below gives f=1 and g=1.
f = FreeFile
g = FreeFile

So you probably want
f = FreeFile
Open ..As #f ..
g = FreeFile
..
Would also like commas between the output data fields

How about just
MyRecOut.AccNo = MyRecIn.AccNo & ","

Hilton wrote:
Can someone please help to fix & improve this code? Data files below with
two questions:

Option Explicit
Type RecordIn
AccNo As String * 3
Com1 As String * 1
TrxName As String * 4
Com2 As String * 1
EffDate As String * 10
LineFeed As String * 2
End Type

Type RecordOut
AccNo As String * 3
TrxName As String * 4
EffDate As String * 10
Ind As String * 3
LineFeed As String * 2
End Type

Sub Button3_Click()
Dim MyRecIn As RecordIn
Dim MyRecOut As RecordOut
Dim f As Integer
Dim g As Integer
Dim CurrAcc As String
Dim CurrTrx As String
Dim CurrDt As String
Dim OutAcc As String
Dim OutTrx As String
Dim OutDt As String
Dim OutInd As String

Dim OutAcc1 As String
Dim OutTrx1 As String
Dim OutDt1 As String

Dim i As Integer
Dim r As Long
f = FreeFile
g = FreeFile


Open "c:\hil\inpn.txt" For Random As #f Len = Len(MyRecIn)
g = FreeFile
Open "c:\hil\out.txt" For Random As #g Len = Len(MyRecOut)

r = 0

Do Until EOF(f)
r = r + 1
Get #f, r, MyRecIn
CurrAcc = MyRecIn.AccNo
CurrTrx = MyRecIn.TrxName
CurrDt = MyRecIn.EffDate
Do Until MyRecIn.AccNo < CurrAcc
Get #f, r, MyRecIn
MyRecOut.AccNo = MyRecIn.AccNo
MyRecOut.TrxName = MyRecIn.TrxName
MyRecOut.EffDate = MyRecIn.EffDate
MyRecOut.Ind = MyRecIn.TrxName
Put #g, r, MyRecOut
OutAcc = MyRecOut.AccNo
OutTrx = MyRecOut.TrxName
OutDt = MyRecOut.EffDate
OutInd = MyRecOut.Ind
r = r + 1
Loop

r = r - 2
Get #f, r, MyRecIn
OutAcc1 = MyRecIn.AccNo
OutTrx1 = MyRecIn.TrxName
OutDt1 = MyRecIn.EffDate

If MyRecIn.TrxName < "Curr" Then
MyRecOut.AccNo = MyRecIn.AccNo
MyRecOut.TrxName = MyRecIn.TrxName
MyRecOut.EffDate = MyRecIn.EffDate
MyRecOut.Ind = "Off"
Put #g, r, MyRecOut
End If

Loop

Close #f
Close #g
MsgBox ("End of Run")
End Sub


Input file:
001,Prev,31/12/2003
001,Curr,31/12/2004
002,Prev,31/12/2003
002,PI ,01/01/2004
003,Prev,31/12/2004


Output file:
001Prev31/12/2003Pre
001Curr31/12/2004Cur
002Prev31/12/2003Pre
002PI 01/01/2004Off
003Prev31/12/2004Off *

* The last record is incorrect - should show "Pre". There is also an extra
output "record" just made up of spaces - ends where the asterisk is. This
must not appear. Would also like commas between the output data fields.

Thanks

Hilton


  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35
Default Fix this Code?

Dave D-C thanks for the reply but I'm confused by the response. Does this
fix the 2 issues I have raised?

"Dave D-C" wrote in message
...
On my XL97, the below gives f=1 and g=1.
f = FreeFile
g = FreeFile

So you probably want
f = FreeFile
Open ..As #f ..
g = FreeFile
..
Would also like commas between the output data fields

How about just
MyRecOut.AccNo = MyRecIn.AccNo & ","

Hilton wrote:
Can someone please help to fix & improve this code? Data files below with
two questions:

Option Explicit
Type RecordIn
AccNo As String * 3
Com1 As String * 1
TrxName As String * 4
Com2 As String * 1
EffDate As String * 10
LineFeed As String * 2
End Type

Type RecordOut
AccNo As String * 3
TrxName As String * 4
EffDate As String * 10
Ind As String * 3
LineFeed As String * 2
End Type

Sub Button3_Click()
Dim MyRecIn As RecordIn
Dim MyRecOut As RecordOut
Dim f As Integer
Dim g As Integer
Dim CurrAcc As String
Dim CurrTrx As String
Dim CurrDt As String
Dim OutAcc As String
Dim OutTrx As String
Dim OutDt As String
Dim OutInd As String

Dim OutAcc1 As String
Dim OutTrx1 As String
Dim OutDt1 As String

Dim i As Integer
Dim r As Long
f = FreeFile
g = FreeFile


Open "c:\hil\inpn.txt" For Random As #f Len = Len(MyRecIn)
g = FreeFile
Open "c:\hil\out.txt" For Random As #g Len = Len(MyRecOut)

r = 0

Do Until EOF(f)
r = r + 1
Get #f, r, MyRecIn
CurrAcc = MyRecIn.AccNo
CurrTrx = MyRecIn.TrxName
CurrDt = MyRecIn.EffDate
Do Until MyRecIn.AccNo < CurrAcc
Get #f, r, MyRecIn
MyRecOut.AccNo = MyRecIn.AccNo
MyRecOut.TrxName = MyRecIn.TrxName
MyRecOut.EffDate = MyRecIn.EffDate
MyRecOut.Ind = MyRecIn.TrxName
Put #g, r, MyRecOut
OutAcc = MyRecOut.AccNo
OutTrx = MyRecOut.TrxName
OutDt = MyRecOut.EffDate
OutInd = MyRecOut.Ind
r = r + 1
Loop

r = r - 2
Get #f, r, MyRecIn
OutAcc1 = MyRecIn.AccNo
OutTrx1 = MyRecIn.TrxName
OutDt1 = MyRecIn.EffDate

If MyRecIn.TrxName < "Curr" Then
MyRecOut.AccNo = MyRecIn.AccNo
MyRecOut.TrxName = MyRecIn.TrxName
MyRecOut.EffDate = MyRecIn.EffDate
MyRecOut.Ind = "Off"
Put #g, r, MyRecOut
End If

Loop

Close #f
Close #g
MsgBox ("End of Run")
End Sub


Input file:
001,Prev,31/12/2003
001,Curr,31/12/2004
002,Prev,31/12/2003
002,PI ,01/01/2004
003,Prev,31/12/2004


Output file:
001Prev31/12/2003Pre
001Curr31/12/2004Cur
002Prev31/12/2003Pre
002PI 01/01/2004Off
003Prev31/12/2004Off *

* The last record is incorrect - should show "Pre". There is also an

extra
output "record" just made up of spaces - ends where the asterisk is. This
must not appear. Would also like commas between the output data fields.

Thanks

Hilton




  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 176
Default Fix this Code?

I see my comments weren't helpful.
I just saw a couple of possible problems and posted.

Without testing your routines, I see a few actual problems:
1) Add the following after your Get statements:
MsgBox r & " " & RecordIn.AccNo
You will see that EOF doesn't work like you think.
See the help on EOF()
2) You don't have Com1 and Com2 in your output records,
so you can't expect commas in the output.
3) You never set RecordOut.Linefeed to anything.
Single-cycle (F8) through your code to see what it's doing.

"Hilton" wrote:
Dave D-C thanks for the reply but I'm confused by the response. Does this
fix the 2 issues I have raised?


"Dave D-C" wrote:

[deleted]

Hilton wrote:
Can someone please help to fix & improve this code? Data files below with
two questions:

Option Explicit
Type RecordIn
AccNo As String * 3
Com1 As String * 1
TrxName As String * 4
Com2 As String * 1
EffDate As String * 10
LineFeed As String * 2
End Type

Type RecordOut
AccNo As String * 3
TrxName As String * 4
EffDate As String * 10
Ind As String * 3
LineFeed As String * 2
End Type

Sub Button3_Click()
Dim MyRecIn As RecordIn
Dim MyRecOut As RecordOut
Dim f As Integer
Dim g As Integer
Dim CurrAcc As String
Dim CurrTrx As String
Dim CurrDt As String
Dim OutAcc As String
Dim OutTrx As String
Dim OutDt As String
Dim OutInd As String

Dim OutAcc1 As String
Dim OutTrx1 As String
Dim OutDt1 As String

Dim i As Integer
Dim r As Long
f = FreeFile
g = FreeFile


Open "c:\hil\inpn.txt" For Random As #f Len = Len(MyRecIn)
g = FreeFile
Open "c:\hil\out.txt" For Random As #g Len = Len(MyRecOut)

r = 0

Do Until EOF(f)
r = r + 1
Get #f, r, MyRecIn
CurrAcc = MyRecIn.AccNo
CurrTrx = MyRecIn.TrxName
CurrDt = MyRecIn.EffDate
Do Until MyRecIn.AccNo < CurrAcc
Get #f, r, MyRecIn
MyRecOut.AccNo = MyRecIn.AccNo
MyRecOut.TrxName = MyRecIn.TrxName
MyRecOut.EffDate = MyRecIn.EffDate
MyRecOut.Ind = MyRecIn.TrxName
Put #g, r, MyRecOut
OutAcc = MyRecOut.AccNo
OutTrx = MyRecOut.TrxName
OutDt = MyRecOut.EffDate
OutInd = MyRecOut.Ind
r = r + 1
Loop

r = r - 2
Get #f, r, MyRecIn
OutAcc1 = MyRecIn.AccNo
OutTrx1 = MyRecIn.TrxName
OutDt1 = MyRecIn.EffDate

If MyRecIn.TrxName < "Curr" Then
MyRecOut.AccNo = MyRecIn.AccNo
MyRecOut.TrxName = MyRecIn.TrxName
MyRecOut.EffDate = MyRecIn.EffDate
MyRecOut.Ind = "Off"
Put #g, r, MyRecOut
End If

Loop

Close #f
Close #g
MsgBox ("End of Run")
End Sub


Input file:
001,Prev,31/12/2003
001,Curr,31/12/2004
002,Prev,31/12/2003
002,PI ,01/01/2004
003,Prev,31/12/2004


Output file:
001Prev31/12/2003Pre
001Curr31/12/2004Cur
002Prev31/12/2003Pre
002PI 01/01/2004Off
003Prev31/12/2004Off *

* The last record is incorrect - should show "Pre". There is also an

extra
output "record" just made up of spaces - ends where the asterisk is. This
must not appear. Would also like commas between the output data fields.

Thanks

Hilton




Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
split post code (zip code) out of cell that includes full address Concord Excel Discussion (Misc queries) 4 October 15th 09 06:59 PM
Code to conditional format all black after date specified in code? wx4usa Excel Discussion (Misc queries) 3 December 26th 08 07:06 PM
Drop Down/List w/Code and Definition, only code entered when selec Spiritdancer Excel Worksheet Functions 2 November 2nd 07 03:57 AM
option buttons run Click code when value is changed via VBA code neonangel Excel Programming 5 July 27th 04 08:32 AM
VBA code delete code but ask for password and unlock VBA protection WashoeJeff Excel Programming 0 January 27th 04 07:07 AM


All times are GMT +1. The time now is 04:26 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"