|
Subject:
|
2 errors to rectify
|
|
Posted By:
|
esfaryn
|
Post Date:
|
10/4/2005 1:33:34 AM
|
FIRST ERROR
At first the hyperlink was working just fine. Only after I change the spreadsheet name, an error occur. By right, when I retrieve data from the database and if there is an error, it will appear on the error spreadsheet. On the error spreadsheet, there will be a hyperlink on the sentence that leads to the error. However when I change the spreadsheet name, the link doesnt work. When clicked on it, and error occurs stating "Reference is not valid." Below is the codings.
Public Sub AddErrorEntry(wb As Workbook, ws As Worksheet, _
row As Integer, col As Integer, _
description As String)
Dim err_row As Integer
Dim cellname As String
' Find the first empty row
err_row = GetErrorStartRow(wb)
With wb.Worksheets("Errors")
.Cells(err_row, 1).Value = ws.name
.Cells(err_row, 2).Value = row
.Cells(err_row, 3).Value = description
End With
' Add a name to the cell
cellname = "Error_" & Format(row, "00000") & Format(col, "00")
ws.Names.Add cellname, ws.Cells(row, col)
' Create hyperlink to cell
ws.Hyperlinks.Add _
wb.Worksheets("Errors").Range("A" & err_row & ":C" & err_row), _
Empty, ws.name & "!" & cellname
End Sub
SECOND ERROR
Data retrived from the database will be sorted out into 2 different spreadsheet "Bd_eQ" and "Bd&Eq_Cance&Re-inp". In both spreadsheet all the columns are the same. However the data retrived in "Bd&Eq_Cance&Re-inp" is not in the correct column as in "Bd_eQ". But both of the codings are the same. Please help me look out for the errors.
' ================================================================
'
' Extract records from a specified Socrates trade file.
'
' Params:
' trd_file File object which refers to a trade file to
' perform extraction
' wb Workbook to store extracted records
' drow1 (Input) Specify the starting row in the
' Bd&Eq worksheet
' (Output) The next starting row in the
' Bd&Eq worksheet
' drow2 (Input) Specify the starting row in the
' Bd&Eq_Canc&Re-inp worksheet
' (Output) The next starting row in the
' Bd&Eq_Canc&Re-inp worksheet
' connGems Connection to the GEMS database
' num_rows (Output) Number of rows extracted
'
' Return value:
' True if successful, False if errors encountered.
'
' ================================================================
Private Function ExtractFromFile(trd_file As File, _
wb As Workbook, _
ByRef drow1 As Integer, _
ByRef drow2 As Integer, _
connGems As ADODB.Connection, _
ByRef num_rows As Integer) _
As Boolean
Dim fname As String
Dim wb_tmp As Workbook
Dim str As String
Dim drow As Integer
Dim srow As Integer
Dim ws As Worksheet
Dim dic As Dictionary
Dim broker As String
Dim blockid As String
Dim currAbbr As String
Dim digits As Integer
Dim mv As Double
Dim main_wb As Workbook
Dim calcType As String
Dim errors As Boolean
On Error GoTo Err_Handler
' Make sure file is not 0-byte file
If trd_file.Size = 0 Then Exit Function
' Convert file
fname = ConvertTradeFile(trd_file)
' Open converted file in workbook
Set main_wb = ActiveWorkbook
Workbooks.Open Filename:=fname, Format:=6, delimiter:=Chr(255)
Set wb_tmp = ActiveWorkbook
main_wb.Activate
srow = 1 ' Source: start from 1st row
' Create dictionary for holding row numbers
' used for mapping CPARTY code
Set dic = New Dictionary
' Do mappings
With wb_tmp.ActiveSheet
Do While Len(.Cells(srow, SOCR_TRANSACTION_CODE)) = 1
' Extract only if row is Omnibus level
' Exclude: - IPT trades (Exec_Broker_ID = 90857)
' - IMS_Flag = "Y"
If Trim(.Cells(srow, SOCR_ACCOUNT_CLIENT_ID)) Like "?999" And _
Trim(.Cells(srow, SOCR_EXECUTION_BROKER_ID)) <> "90857" And _
Trim(.Cells(srow, SOCR_IMS_FLAG)) <> "Y" Then
' Check STRSTATUSFLAG to see which worksheet to use
If Trim(.Cells(srow, SOCR_CANCEL_FLAG)) = "NEW" Then
' Write to 'Bd&Eq' worksheet
Set ws = wb.Worksheets(1)
drow = drow1
' Increment row counter for 'Bd&Eq' worksheet
drow1 = drow1 + 1
Else
' Write to 'Bd&Eq_Canc&Re-inp' worksheet
Set ws = wb.Worksheets(2)
drow = drow2
' Increment row counter for 'Bd&Eq_Canc&Re-inp' worksheet
drow2 = drow2 + 1
End If
' Default sys code in EthSys for Socrates is 3
ws.Cells(drow, COL_EXT_SYS_CODE).Value = 3
' Abbreviation in EthSys for Socrates
ws.Cells(drow, COL_EXT_SYS_ABBR).Value = "Socrates"
' EthSys derived field, not available from Front Office system
' New_FO_Identifier provided instead
'ws.Cells(drow, COL_TXN_ID).Value = .Cells(srow, SOCR_NEW_FO_IDENTIFIER).Value
ws.Cells(drow, COL_TXN_ID).Value = Empty
str = Trim(.Cells(srow, SOCR_CANCEL_FLAG).Value)
If str = "NEW" Or str = "REIN" Then
' Map NEW or REIN to 1 and PEND
ws.Cells(drow, COL_STATUS_TXN).Value = 1
ws.Cells(drow, COL_STATUS_NAME).Value = "PEND"
' Map Cancel_PA_System_ID from NEXT row (Allocation level)
ws.Cells(drow, COL_REVERSED_TXN).Value = .Cells(srow + 1, SOCR_CANCEL_PA_SYSTEM_ID).Value
Else
' Map REV to 6 and CANCEL
ws.Cells(drow, COL_STATUS_TXN).Value = 6
ws.Cells(drow, COL_STATUS_NAME).Value = "CANCEL"
' Map Cancel_PA_System_ID from NEXT row (Allocation level)
'ws.Cells(drow, COL_REINPUT_TXN).Value = .Cells(srow + 1, SOCR_CANCEL_PA_SYSTEM_ID).Value
ws.Cells(drow, COL_REINPUT_TXN).Value = Empty
End If
' Lookup TBLGS_CLIENT for account_group given Account_Client_ID
ws.Cells(drow, COL_ACCNT_GROUP).Value = GetAccountGroup(connGems, .Cells(srow, SOCR_ACCOUNT_CLIENT_ID))
' Misc fields
ws.Cells(drow, COL_TRADE_DATE).Value = ParseSocratesDate( _
.Cells(srow, SOCR_TRADE_DATE))
ws.Cells(drow, COL_VALUE_DATE).Value = ParseSocratesDate( _
.Cells(srow, SOCR_SETTLEMENT_DATE))
ws.Cells(drow, COL_CLIENT_CODE).Value = .Cells(srow, SOCR_ACCOUNT_CLIENT_ID)
ws.Cells(drow, COL_SECURITY_ID).Value = .Cells(srow, SOCR_SECURITY_CLIENT_ID)
' Currency related fields
If GetCurrencyAbbrAndRounding(connGems, .Cells(srow, SOCR_SETTLE_CURRENCY), _
currAbbr, digits) Then
' Function succeeded
'ws.Cells(drow, COL_TRADE_CURR).Value = currAbbr
'ws.Cells(drow, COL_SETTLED_CURR).Value = currAbbr
Else
' Currency code not found
'ws.Cells(drow, COL_TRADE_CURR).Value = "ERR"
'ws.Cells(drow, COL_SETTLED_CURR).Value = "ERR"
AddErrorEntry wb, ws, drow, COL_TRADE_CURR, "Invalid currency code: " & _
.Cells(srow, SOCR_SETTLE_CURRENCY)
AddErrorEntry wb, ws, drow, COL_SETTLED_CURR, "Invalid currency code: " & _
.Cells(srow, SOCR_SETTLE_CURRENCY)
errors = True
End If
ws.Cells(drow, COL_TRADE_CURR).Value = .Cells(srow, SOCR_SETTLE_CURRENCY_CODE)
ws.Cells(drow, COL_SETTLED_CURR).Value = .Cells(srow, SOCR_SETTLE_CURRENCY_CODE)
str = Trim(.Cells(srow, SOCR_TRANSACTION_CODE))
If str = "B" Then
' Map B to 1 and BUY
ws.Cells(drow, COL_TYPE_TXN).Value = 1
ws.Cells(drow, COL_TYPE_TXN_DESC).Value = "BUY"
Else
' Map S to 2 and SELL
ws.Cells(drow, COL_TYPE_TXN).Value = 2
ws.Cells(drow, COL_TYPE_TXN_DESC).Value = "SELL"
End If
' Special processing for Execution broker id 90858
broker = Trim(.Cells(srow, SOCR_EXECUTION_BROKER_ID))
If broker = "90858" Then
' Check if entry with Block_User_Field for current block exists
' Note: Block_User_Field is on the allocation level, i.e. next row
blockid = .Cells(srow + 1, SOCR_BLOCK_USER_FIELD)
If Not dic.Exists(blockid) Then
' Map and store the code into the current row
ws.Cells(drow, COL_CPARTY_CODE).Value = _
GetCounterPartyCode(Left(Trim(.Cells(srow, SOCR_ACCOUNT_CLIENT_ID)), 1))
' Add entry to dictionary
dic.Add blockid, drow
Else
' A matching row with the same block id has been found earlier
' Store the counter party code of that row into the current row
' Note: The matching row number is stored as the item data for
' the key (blockid) in the dictionary
ws.Cells(drow, COL_CPARTY_CODE).Value = _
ws.Cells(CInt(dic.Item(blockid)), COL_CPARTY_CODE)
' Map and store the code in the current row into the matching row
ws.Cells(CInt(dic.Item(blockid)), COL_CPARTY_CODE).Value = _
GetCounterPartyCode(Left(Trim(.Cells(srow, SOCR_ACCOUNT_CLIENT_ID)), 1))
' Remove entry from dictionary
dic.Remove blockid
End If
Else
' Just store the value if Execution broker id is not 90858
ws.Cells(drow, COL_CPARTY_CODE).Value = _
.Cells(srow, SOCR_EXECUTION_BROKER_ID)
End If
' MV
mv = MapMarketValueGains(connGems, _
.Cells(srow, SOCR_SECURITY_CLIENT_ID).Value, _
.Cells(srow, SOCR_TOTAL_AVG_PRICE).Value, _
.Cells(srow, SOCR_QUANTITY).Value, _
digits, calcType)
If Err.Number = ERR_INVALID_CALC_TYPE Then
' Error
ws.Cells(drow, COL_MV).Value = "ERR"
AddErrorEntry wb, ws, drow, COL_MV, "Invalid CalcType: " & calcType
errors = True
ElseIf Err.Number = 0 Then
' No errors
ws.Cells(drow, COL_MV).Value = mv
End If
' More fields
ws.Cells(drow, COL_TXN_PRICE).Value = .Cells(srow, SOCR_TOTAL_AVG_PRICE)
ws.Cells(drow, COL_TXN_QTY).Value = .Cells(srow, SOCR_QUANTITY)
ws.Cells(drow, COL_COMMISSION).Value = .Cells(srow, SOCR_COMMISSION)
' AI
' Even more fields
ws.Cells(drow, COL_USER_ID_CREATED).Value = .Cells(srow, SOCR_EQUITY_PLACEMENT_CREATED_BY)
ws.Cells(drow, COL_CREATED_DATETIME).Value = ParseTimestamp( _
.Cells(srow, SOCR_TRANSACTION_DATE_TIME))
ws.Cells(drow, COL_DESC_LINE).Value = .Cells(srow, SOCR_ALLOCATIONS_USER_FIELD56)
ws.Cells(drow, COL_TXN_ID_EXT_SYS).Value = .Cells(srow, SOCR_NEW_FO_IDENTIFIER)
ws.Cells(drow, COL_DEALER).Value = .Cells(srow, SOCR_USER_INFORMATION_CLIENT_ID)
End If
' Move to next row
' NO NEED to increment destination row counter since it
' has been incremented at the start
srow = srow + 1
' Increment row counter
num_rows = num_rows + 1
Loop
End With
Exit_Function:
' Close workbook
wb_tmp.Close
' Delete temorary file
Dim fso As New FileSystemObject
fso.DeleteFile fname, True
' Return True on success
ExtractFromFile = Not errors
Exit Function
Err_Handler:
HandleError "modSocrates.ExtractFromFile()"
errors = True
GoTo Exit_Function
End Function
Many thanks in Advance.
Best Regards,
Farina =P
|
|
Reply By:
|
mjppaba
|
Reply Date:
|
10/4/2005 2:24:28 AM
|
FIRST ERROR:
it looks like the reference used in the hyperlink is unnecessary, try the following instead,
' Create hyperlink to cell
ws.Hyperlinks.Add _
wb.Worksheets("Errors").Range("A" & err_row & ":C" & err_row), _
Empty, cellname
More to follow...
cheers
Matt
|
|
Reply By:
|
esfaryn
|
Reply Date:
|
10/4/2005 2:41:20 AM
|
Hey Matt, I tried out your solution but again the same error appear.
Best Regards,
Farina =P
|
|
Reply By:
|
esfaryn
|
Reply Date:
|
10/4/2005 3:16:22 AM
|
I think the error lies in the code below. This is because when I hover over the hyperlink, it is suppose to show the speadsheet name which equals to ws.name but it didnt show. Instead it just proceed with the format.
' Create hyperlink to cell
ws.Hyperlinks.Add _
wb.Worksheets("Errors").Range("A" & err_row & ":C" & err_row), _
Empty, ws.name & "!" & cellname
Best Regards,
Farina =P
|
|
Reply By:
|
mjppaba
|
Reply Date:
|
10/4/2005 3:18:34 AM
|
Hi Farina,
try placing the paramenter names in the code?
' Create hyperlink to cell
ws.Hyperlinks.Add _
Anchor:=wb.Worksheets("Errors").Range("A" & err_row & ":C" & err_row), _
Address:="", SubAddress:=cellname
replace the =Empty with ="" as well.
cheers
Matt
|
|
Reply By:
|
esfaryn
|
Reply Date:
|
10/4/2005 3:43:56 AM
|
The other one also did'nt work. Apparently when I check the hyperlink using insert in excel, in shows 'Bd&Eq_Canc&Re-inp'!Error_0000614. Whereas the original one which is working perfectly just shows the whole line above but without the two (') apostrophe.
Matt, really sorry. Im so irritating? My Supervisor is going to kill me!
Best Regards,
Farina =P
|
|
Reply By:
|
mjppaba
|
Reply Date:
|
10/4/2005 4:14:02 AM
|
can you do the following...
select a sheet which is not "Errors"
record a macro
identify a cell to apply a name e.g. A10
go through the process of creating a named ranged via [insert]...[name]...[define]
give the cell a name and apply the cell's name to the cell.
[OK].
Select the Error Sheet.
Click on [Insert]...[Hyperlink]...[Place in this document]...[Defined Range] select the named range from above.
stop the recording of the macro.
can you show us the code you get from the recorded macro please
cheers
Matt
|
|
Reply By:
|
esfaryn
|
Reply Date:
|
10/4/2005 4:26:44 AM
|
errm, there is no defined range under the hyperlink. just cell reference and defined name.
sorry but i really not good at this. my first time using vba and excel.
Best Regards,
Farina =P
|
|
Reply By:
|
mjppaba
|
Reply Date:
|
10/4/2005 4:33:57 AM
|
I've sent you an email to the default Wrox Email address.
cheers
Matt
|
|
Reply By:
|
esfaryn
|
Reply Date:
|
10/4/2005 9:13:26 PM
|
Anybody else who have any idea on how to solve this problems?
Many thanks in advance!
Best Regards,
Farina =P
|
|
Reply By:
|
mjppaba
|
Reply Date:
|
10/6/2005 12:13:25 PM
|
Problem 1
solution...
' Add a name to the cell
cellname = "Error_" & Format(row, "00000") & Format(col, "00")
wb.Names.Add name:=cellname, RefersToR1C1:="=" & ws.name & "!" & "R" & row & "C" & col
Worksheets("Errors").Select
Range("A" & err_row & ":C" & err_row).Select
' Create hyperlink to cell
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",SubAddress:=cellname
solution 2 to follow...
TTFN
Matt
|
|
