PDA

View Full Version : Simplify Code



gnod
06-16-2008, 08:42 AM
Hi,

can anyone simplify this code. i patterned my code to this KB (http://vbaexpress.com/kb/getarticle.php?kb_id=759)


' *************************************************************************** **
' Create formatted text file.
' *************************************************************************** **
Sub CreateTxtFile()

Dim iHdr(37) As Integer, iDtl(10) As Integer, iTempCtr As Integer
Dim iRow As Long, ictr As Long, fNum As Long
Dim strLine As String, strCell As String

' Show the SaveAs dialog
' Filename is default to the format of TL.yyyymmddhhmmss
sPath = Application.GetSaveAsFilename("TL." & Format(Date, "yyyymmdd") & Format(Time, "hhmmss"))

' If the user select Cancel button
If LCase$(sPath) = "false" Then Exit Sub

' Header Record - Length
iHdr(0) = 1 ' RECORD_TYPE
iHdr(1) = 1 ' TRANS_CODE
iHdr(2) = 12 ' RATE_ID
iHdr(3) = 12 ' CARRIER_ID
iHdr(4) = 1 ' ORIGIN_REG_KEY
iHdr(5) = 35 ' ORIGIN_REG1
iHdr(6) = 35 ' ORIGIN_REG2
iHdr(7) = 1 ' DESTINATION_REG_KEY
iHdr(8) = 35 ' DESTINATION_REG1
iHdr(9) = 35 ' DESTINATION_REG2
iHdr(10) = 8 ' EFFECTIVE
iHdr(11) = 12 ' SERVICE_COM_ID
iHdr(12) = 5 ' CUTOFF_TIME
iHdr(13) = 6 ' TARIFF_CLASS_ID
iHdr(14) = 12 ' PERF_RATING_ID
iHdr(15) = 2 ' FREE_STOPS
iHdr(16) = 11 ' FIRST_STOP_RATE
iHdr(17) = 11 ' SECOND_STOP_RATE
iHdr(18) = 11 ' THIRD_STOP_RATE
iHdr(19) = 11 ' ADDL_STOP_RATE
iHdr(20) = 6 ' DISCOUNT
iHdr(21) = 32 ' TARIFF_INFO
iHdr(22) = 8 ' EXPIRATION
iHdr(23) = 8 ' DATE_INVALID
iHdr(24) = 1 ' SPOT_RATE
iHdr(25) = 12 ' RATE_GROUP_ID
iHdr(26) = 3 ' CURRENCY
iHdr(27) = 12 ' RADIAL_RATE_ID
iHdr(28) = 2 ' RRA_MAX_STOPS
iHdr(29) = 11 ' RRA_MIN_CHARGE
iHdr(30) = 11 ' RRA_MAX_CHARGE
iHdr(31) = 6 ' MAX_PK_DURATION
iHdr(32) = 6 ' MAX_DELV_DURATION
iHdr(33) = 5 ' MAX_PK_DISTANCE
iHdr(34) = 5 ' MAX_DELV_DISTANCE
iHdr(35) = 12 ' ORIGIN_RAIL_RAMP_ID
iHdr(36) = 12 ' DEST_RAIL_RAMP_ID
iHdr(37) = 180 ' NOTES

' Detail Record - Length
iDtl(0) = 1 ' RECORD_TYPE
iDtl(1) = 1 ' TRANS_CODE
iDtl(2) = 12 ' RATE_ID
iDtl(3) = 11 ' VARIABLE_RATE
iDtl(4) = 1 ' RATE_TYPE
iDtl(5) = 11 ' BLANK
iDtl(6) = 11 ' FIXED_CHARGE
iDtl(7) = 12 ' CAPACITY_TYPE_ID
iDtl(8) = 8 ' UNIT_QUANTITY
iDtl(9) = 11 ' UNLOADED_RATE
iDtl(10) = 2 ' MAX_STOPS

ictr = 1

fNum = FreeFile
Open sPath For Output As fNum

For iRow = 7 To ActiveSheet.Range("a65536").End(xlUp).Row
strLine = ""
'For j = 0 To UBound(iHdr)
' strCell = Left$(ActiveSheet.Cells(i, j + 1).Value, iHdr(j))
' strLine = strLine & strCell & String$(iHdr(j) - Len(strCell), Chr$(32))
'Next j

' ***********************************************************************
' Header Record
' ***********************************************************************

' RECORD_TYPE
strCell = Left$("H", iHdr(0))
strLine = strLine & strCell & String$(iHdr(0) - Len(strCell), Chr$(32))
' TRANS_CODE
strCell = Left$("A", iHdr(1))
strLine = strLine & strCell & String$(iHdr(1) - Len(strCell), Chr$(32))
' RATE_ID
strCell = Left$(ictr, iHdr(2))
strLine = strLine & strCell & String$(iHdr(2) - Len(strCell), Chr$(32))
' CARRIER_ID
strCell = Left$(ActiveSheet.Cells(iRow, 1).Value, iHdr(3))
strLine = strLine & strCell & String$(iHdr(3) - Len(strCell), Chr$(32))
' ORIGIN_REG_KEY
strCell = Left$("6", iHdr(4))
strLine = strLine & strCell & String$(iHdr(4) - Len(strCell), Chr$(32))
' ORIGIN_REG1
strCell = Left$(ActiveSheet.Cells(iRow, 2).Value, iHdr(5))
strLine = strLine & strCell & String$(iHdr(5) - Len(strCell), Chr$(32))
' ORIGIN_REG2
strCell = Left$("", iHdr(6))
strLine = strLine & strCell & String$(iHdr(6) - Len(strCell), Chr$(32))
' DESTINATION_REG_KEY
strCell = Left$("7", iHdr(7))
strLine = strLine & strCell & String$(iHdr(7) - Len(strCell), Chr$(32))
' DESTINATION_REG1
strCell = Left$(ActiveSheet.Cells(iRow, 3).Value, iHdr(8))
strLine = strLine & strCell & String$(iHdr(8) - Len(strCell), Chr$(32))
' DESTINATION_REG2
strCell = Left$(ActiveSheet.Cells(iRow, 4).Value, iHdr(9))
strLine = strLine & strCell & String$(iHdr(9) - Len(strCell), Chr$(32))
' EFFECTIVE
strCell = Left$(ActiveSheet.Cells(2, 2).Text, iHdr(10))
strLine = strLine & strCell & String$(iHdr(10) - Len(strCell), Chr$(32))
' SERVICE_COM_ID
strCell = Left$("SINGLE", iHdr(11))
strLine = strLine & strCell & String$(iHdr(11) - Len(strCell), Chr$(32))
' CUTOFF_TIME
strCell = Left$("", iHdr(12))
strLine = strLine & strCell & String$(iHdr(12) - Len(strCell), Chr$(32))
' TARIFF_CLASS_ID
strCell = Left$(ActiveSheet.Cells(iRow, 5).Value, iHdr(13))
strLine = strLine & strCell & String$(iHdr(13) - Len(strCell), Chr$(32))
' PERF_RATING_ID
strCell = Left$("", iHdr(14))
strLine = strLine & strCell & String$(iHdr(14) - Len(strCell), Chr$(32))
' FREE_STOPS
strCell = Left$(ActiveSheet.Cells(iRow, 6).Value, iHdr(15))
strLine = strLine & strCell & String$(iHdr(15) - Len(strCell), Chr$(32))
' FIRST_STOP_RATE
' SECOND_STOP_RATE
' THIRD_STOP_RATE
' ADDL_STOP_RATE
For iTempCtr = 1 To 4
strCell = Left$(ActiveSheet.Cells(iRow, 7).Value, iHdr(iTempCtr + 15))
strLine = strLine & strCell & String$(iHdr(iTempCtr + 15) - Len(strCell), Chr$(32))
Next iTempCtr
' DISCOUNT
' TARIFF_INFO
' EXPIRATION
' DATE_INVALID
' SPOT_RATE
' RATE_GROUP_ID
For iTempCtr = 20 To 25
strCell = Left$("", iHdr(iTempCtr))
strLine = strLine & strCell & String$(iHdr(iTempCtr) - Len(strCell), Chr$(32))
Next iTempCtr
' CURRENCY
strCell = Left$("PHP", iHdr(26))
strLine = strLine & strCell & String$(iHdr(26) - Len(strCell), Chr$(32))
' RADIAL_RATE_ID
' RRA_MAX_STOPS
' RRA_MIN_CHARGE
' RRA_MAX_CHARGE
' MAX_PK_DURATION
' MAX_DELV_DURATION
' MAX_PK_DISTANCE
' MAX_DELV_DISTANCE
' ORIGIN_RAIL_RAMP_ID
' DEST_RAIL_RAMP_ID
' NOTES
For iTempCtr = 27 To 37
strCell = Left$("", iHdr(iTempCtr))
strLine = strLine & strCell & String$(iHdr(iTempCtr) - Len(strCell), Chr$(32))
Next iTempCtr

Print #fNum, strLine
strLine = ""

' ***********************************************************************
' Detail Record
' ***********************************************************************

' RECORD_TYPE
strCell = Left$("D", iDtl(0))
strLine = strLine & strCell & String$(iDtl(0) - Len(strCell), Chr$(32))
' TRANS_CODE
strCell = Left$("A", iDtl(1))
strLine = strLine & strCell & String$(iDtl(1) - Len(strCell), Chr$(32))
' RATE_ID
strCell = Left$(ictr, iDtl(2))
strLine = strLine & strCell & String$(iDtl(2) - Len(strCell), Chr$(32))
' VARIABLE_RATE
strCell = Left$("", iDtl(3))
strLine = strLine & strCell & String$(iDtl(3) - Len(strCell), Chr$(32))
' RATE_TYPE
strCell = Left$(ActiveSheet.Cells(3, 4).Text, iDtl(4))
strLine = strLine & strCell & String$(iDtl(4) - Len(strCell), Chr$(32))
' BLANK
strCell = Left$("", iDtl(5))
strLine = strLine & strCell & String$(iDtl(5) - Len(strCell), Chr$(32))
' FIXED_CHARGE
strCell = Left$(ActiveSheet.Cells(iRow, 8).Value, iDtl(6))
strLine = strLine & strCell & String$(iDtl(6) - Len(strCell), Chr$(32))
' CAPACITY_TYPE_ID
' UNIT_QUANTITY
' UNLOADED_RATE
For iTempCtr = 7 To 9
strCell = Left$("", iDtl(iTempCtr))
strLine = strLine & strCell & String$(iDtl(iTempCtr) - Len(strCell), Chr$(32))
Next iTempCtr
' MAX_STOPS
strCell = Left$(ActiveSheet.Cells(iRow, 9).Text, iDtl(10))
strLine = strLine & strCell & String$(iDtl(10) - Len(strCell), Chr$(32))

Print #fNum, strLine
ictr = ictr + 1
Next iRow

Close #fNum

MsgBox "Done...", vbInformation, "Convert To Txt"
End Sub

thanks..

Bob Phillips
06-16-2008, 08:56 AM
So what exactly is the problem that is in need of a resolution?

gnod
06-16-2008, 09:02 AM
is there any part that i should create a loop / function to make it look good because my code looks bad..


thanks..

Charlize
06-17-2008, 06:22 AM
Don't know if this is better.Sub header_length()
'Don't know if this looks better ?
Dim iHdr(37) As Long
Dim myitem As Variant
Dim vloop As Long
vloop = 0
For Each myitem In Array(1, 1, 12, 12, 1, 35, 35, 1, 35, 35, 8, 12, _
5, 6, 12, 2, 11, 11, 11, 11, 6, 32, 8, 8, 1, _
12, 3, 12, 2, 11, 11, 6, 6, 5, 5, 12, 12, 180)
iHdr(vloop) = myitem
vloop = vloop + 1
Next myitem
End SubCharlize