Solved: 2 errors to rectify

[esfaryn]

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.

[VBA] 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[/VBA]

SECOND ERROR

Data retrived from the database will be sorted out into 2 different spreadsheet "Bd_eQ" and "Bd&Eq_Cance&Re-inp" but placed in the same workbook. In both spreadsheet all the columns are the same. However the data retrived in "Bd&Eq_Cance&Re-inp" is not placed in the correct column as in "Bd_eQ". But both of the codings are the same. Please help me look out for the errors.

[VBA] ' ================================================================
'
' 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[/VBA]

Many thanks in Advance.My brain is totally fried after thinking about this error for a couple of days. And tomorrow my supervisor wants to see me regarding this progress. I am in deep ****.


Best Regards,
Farina =P

[malik641]

Welcome to the site Farina

Just so you know, I placed your code in VB Tags

[esfaryn]

oraite. thanks =)

[acw]

Hi

Error 1:
Can you give an example of the work flow, what you did, what you changed the spreadsheet name to etc. On the sample I tried, it worked when I had the original workbook name, and it also worked when I saved it as another name.


Tony

[esfaryn]

The old one was;
[VBA]
Public Function PrepareNewWorkbook() As Workbook
' Create new workbook
Dim wb As Workbook
Set wb = Workbooks.Add

' Rename worksheets in new workbook
wb.Worksheets(1).name = "BOND_EQ"
wb.Worksheets(2).name = "BOND_EQ_REINREV"
wb.Worksheets(3).name = "Errors"

' Return new workbook
Set PrepareNewWorkbook = wb
End Function
[/VBA]

Here is the codings to the new renamed spreadsheet;
[VBA]
Public Function PrepareNewWorkbook() As Workbook
' Create new workbook
Dim wb As Workbook
Set wb = Workbooks.Add

' Rename worksheets in new workbook
wb.Worksheets(1).name = "Bd&Eq"
wb.Worksheets(2).name = "Bd&Eq Canc&Re-inp"
wb.Worksheets(3).name = "Errors"

' Return new workbook
Set PrepareNewWorkbook = wb
End Function
[/VBA]

At first I though it wont cause any problems if i just change the spreadsheet name, but it does. Somehow i just cant find the reference of the cell to the link in the coding. I added the screenshot. Hopefully it will be much more clearer to you.

[acw]

Hi

1) When you create a new workbook, what is the default number of sheets? If you rely on having 3 sheets as the default, then you may run into problems if the user has a new workbook set up to generate only 1 sheet.

2) How are you invoking the function??? What code are you using?


Tony

[esfaryn]

Im using all three worksheet in the workbook. The codings are above in the first entry.

[acw]

Hi

I called both the above function using
[VBA]
Sub ccc()
Set fred = PrepareNewWorkbook()
End Sub
[/VBA]

and they both created the new workbooks with the correctly named sheets. Any new workbook has 3 sheets as the default.

Can you give a more complete example of the workflow...


Tony

[esfaryn]

guys, thanks for all the help, i manage to get it right. now i have another problem.

how to get the first character of one string and the last character of another string? is it by using string.substring(int, int)?

[acw]

Hi

1) How did you resolve the other problem
2) Use the LEFT and RIGHT functions. You don't say where the string resides but say you have the string "fred" in A1 and "lunch" in B1
=left(a1,1) will give f and
=right(b1,1) will give h


Tony

[esfaryn]

guys i need you help. i need to exclude data during the retrival plus i am not so sure where to place the sentence. therefore i place excludeIPT method before the rest of the retriving codes.

[VBA]
' ================================================================
'
' Extract records from Apollo database.
'
' Params:
' dtFrom Extract files starting from this date
' dtTo Extract files up to this date
'
' ================================================================
Public Sub DoExtractApollo(dtFrom As Date, dtTo As Date)
Dim conn As adodb.Connection
Dim connGems As adodb.Connection
Dim rs As New adodb.Recordset
Dim squery As String
Dim row As Integer
Dim row1 As Integer
Dim row2 As Integer
Dim str As String
Dim ws As Worksheet
Dim wb As Workbook
Dim nominalAmt As Double
Dim mv As Double
Dim currAbbr As String
Dim digits As Integer
Dim calcType As String
Dim errors As Boolean
Dim num_rows As Integer
Dim brokerid As String
Dim cparty As String
Dim cpartyalpha As String

On Error GoTo Error_Handler

' Set hourglass cursor
Application.Cursor = xlWait

' Add entry to log
AddLogEntry "** Extraction from Apollo database started. " & vbCrLf & _
" Date range: " & dtFrom & " to " & dtTo

' Establish database connection
Set conn = GetApolloConnection
Set connGems = GetGemsConnection
If conn Is Nothing Or connGems Is Nothing Then
' Error occured
MsgBox "Unable to establish database connection.", vbExclamation
AddLogEntry "** Extraction from Apollo database aborted." & vbCrLf & _
" Error: Unable to establish database connection. "
Application.Cursor = xlDefault
Exit Sub
End If

' Build query string
squery = "SELECT STRSTATUSFLAG, STRREVERSE_ID, STRPORTFOLIO, " & _
"DTETRADE, DTESETTLEMENT, STRPORTFOLIO, STREXECUTION_BROKER, " & _
"DBLSEC_GEMS_ID, STRSETTLE_CURRENCY, STRTRANSACTION_CODE, " & _
"DBLPRICE, DBLQUANTITY, DBLCOMMISSION, STRPREPARED_BY_USER, " & _
"DTEINPUT, STRREMARKS, STRFRONT_OFFICE_ID, STRTRADER, STRSECURITY_ID " & _
"FROM Apollo_trades WHERE DTEINPUT >= " & _
"CONVERT(datetime, '" & Format(dtFrom, "yyyy-mm-dd hh:mm:ss") & "', 20) " & _
" AND DTEINPUT <= " & _
"CONVERT(datetime, '" & Format(dtTo, "yyyy-mm-dd hh:mm:ss") & "', 20) "
'sQuery = sQuery & " AND STRDEALTYPE IS NULL "

' Extract only if row is Omnibus level AND
' if it represents an SE trade.
squery = squery & " AND DBLSUB_ID = 0 AND DBLBLOCK_ID = 0 "

' Exclude fields with STRSTATUSFLAG_IMS = 'Y'
squery = squery & " AND (STRSTATUSFLAG_IMS IS NULL OR STRSTATUSFLAG <> 'Y') "

' Execute query
Set rs.ActiveConnection = conn
rs.Open squery

If rs.EOF Then
' No records found
MsgBox "No records found.", vbExclamation
GoTo Exit_Sub
End If

' Create and prepare new workbook with necessary worksheets
Set wb = PrepareNewWorkbook

' Write header row
WriteApolloHeader wb.Worksheets(1), dtFrom, dtTo
WriteApolloHeader wb.Worksheets(2), dtFrom, dtTo
wb.Worksheets(1).Names.Add name:="BondEqHeaderRng", _
RefersTo:="=Bd&Eq!$A$5:$AC$5", Visible:=True
wb.Worksheets(2).Names.Add name:="BondEqHeaderRng", _
RefersTo:="=Bd&Eq Canc&Re-inp!$A$5:$AC$5", Visible:=True

' Loop through record set
rs.MoveFirst
row1 = 6
row2 = 6

Do While Not rs.EOF
If ExcludeIPT(connGems, cparty, cpartyalpha, rs!STREXECUTION_BROKER) Then

' Check STRSTATUSFLAG to see which worksheet to use
If rs!STRSTATUSFLAG = "NEW" Then
' Write to 'Bd&Eq' worksheet
Set ws = wb.Worksheets(1)
row = row1

' Increment row counter for 'Bd&Eq' worksheet
row1 = row1 + 1
Else
' Write to 'Bd&Eq_REINREV' worksheet
Set ws = wb.Worksheets(2)
row = row2

' Increment row counter for 'Bd&Eq Canc&Re-inp' worksheet
row2 = row2 + 1
End If

' Default sys code in EthSys for Apollo is 8
ws.Cells(row, COL_EXT_SYS_CODE).Value = 8

' Abbreviation in EthSys for Apollo
ws.Cells(row, COL_EXT_SYS_ABBR).Value = "Apollo"

' EthSys derived field, not available from Front Office system
' STRFRONT_OFFICE_ID can be provided instead but
' leave blank for the time being.
ws.Cells(row, COL_TXN_ID).Value = Empty

str = rs!STRSTATUSFLAG
If str = "NEW" Or str = "REIN" Then
' Map NEW or REIN to 1 and PEND
ws.Cells(row, COL_STATUS_TXN).Value = 1
ws.Cells(row, COL_STATUS_NAME).Value = "PEND"

' Do not map STRREVERSE_ID as Apollo
' does not support reinput for SE trade
Else
' Map REV to 6 and CANCEL
ws.Cells(row, COL_STATUS_TXN).Value = 6
ws.Cells(row, COL_STATUS_NAME).Value = "CANCEL"

' Map STRREVERSE_ID
ws.Cells(row, COL_REVERSED_TXN).Value = rs!STRREVERSE_ID
End If

' Lookup TBLGS_CLIENT for account_group given Account_Client_ID
ws.Cells(row, COL_ACCNT_GROUP).Value = GetAccountGroup(connGems, rs!STRPORTFOLIO)

' Misc fields
ws.Cells(row, COL_TRADE_DATE).Value = CDate(rs!DTETRADE)
ws.Cells(row, COL_VALUE_DATE).Value = CDate(rs!DTESETTLEMENT)
ws.Cells(row, COL_CLIENT_CODE).Value = rs!STRPORTFOLIO
ws.Cells(row, COL_CPARTY_CODE).Value = rs!STREXECUTION_BROKER
ws.Cells(row, COL_SECURITY_ID).Value = rs!DBLSEC_GEMS_ID

' Currency related fields
If GetCurrencyAbbrAndRounding(connGems, rs!STRSETTLE_CURRENCY, _
currAbbr, digits) Then
' Function succeeded
ws.Cells(row, COL_TRADE_CURR).Value = currAbbr
ws.Cells(row, COL_SETTLED_CURR).Value = currAbbr
Else
' Currency code not found
ws.Cells(row, COL_TRADE_CURR).Value = "ERR"
ws.Cells(row, COL_SETTLED_CURR).Value = "ERR"
AddErrorEntry wb, ws, row, COL_TRADE_CURR, "Invalid currency code: " & _
rs!STRSETTLE_CURRENCY
AddErrorEntry wb, ws, row, COL_SETTLED_CURR, "Invalid currency code: " & _
rs!STRSETTLE_CURRENCY
errors = True
End If

str = rs!STRTRANSACTION_CODE
If str = "B" Then
' Map B to 1 and BUY
ws.Cells(row, COL_TYPE_TXN).Value = 1
ws.Cells(row, COL_TYPE_TXN_DESC).Value = "BUY"
Else
' Map S to 2 and SELL
ws.Cells(row, COL_TYPE_TXN).Value = 2
ws.Cells(row, COL_TYPE_TXN_DESC).Value = "SELL"
End If

' MV
mv = MapMarketValueGems(connGems, rs!DBLSEC_GEMS_ID, _
rs!DBLPRICE, rs!DBLQUANTITY, digits, calcType)
If Err.Number = ERR_INVALID_CALC_TYPE Then
' Error
ws.Cells(row, COL_MV).Value = "Error - CalcType = " & calcType
AddErrorEntry wb, ws, row, COL_MV, "Invalid CalcType: " & calcType
errors = True

ElseIf Err.Number = 0 Then
' No errors
ws.Cells(row, COL_MV).Value = mv
End If

' More fields
ws.Cells(row, COL_TXN_PRICE).Value = rs!DBLPRICE
ws.Cells(row, COL_TXN_QTY).Value = rs!DBLQUANTITY

' Ethsys keeps +ve figure for commission but
' RIMS requires -ve sign for commission
ws.Cells(row, COL_COMMISSION).Value = CDbl(-1 * rs!DBLCOMMISSION)

' AI: For future use

' Even more fields
ws.Cells(row, COL_USER_ID_CREATED).Value = rs!STRPREPARED_BY_USER
ws.Cells(row, COL_CREATED_DATETIME).Value = CDate(rs!DTEINPUT)
ws.Cells(row, COL_DESC_LINE).Value = rs!STRREMARKS
ws.Cells(row, COL_TXN_ID_EXT_SYS).Value = rs!STRFRONT_OFFICE_ID
ws.Cells(row, COL_DEALER).Value = rs!STRTRADER

' Move to next row
' NO NEED to increment row counter since it
' has been incremented at the start
rs.MoveNext

num_rows = num_rows + 1
End If
Loop

' AutoFit columns on worksheets
AutoFitColumns wb.Worksheets(1)
AutoFitColumns wb.Worksheets(2)
AutoFitColumns wb.Worksheets(3)

Exit_Sub:
' Close recordset
rs.Close

' Restore cursor
Application.Cursor = xlDefault

' Add entry to log
If Not errors Then
If num_rows > 0 Then
AddLogEntry "** Extraction from Apollo database ended successfully." & vbCrLf & _
" Extracted data from " & num_rows & " row(s)."
MsgBox "Extracted data from " & num_rows & " row(s).", vbInformation
Else
AddLogEntry "** Extraction from Apollo database ended. " & vbCrLf & _
" No rows found matching criteria."
MsgBox "No rows found matching criteria.", vbExclamation
End If
Else
AddLogEntry "** Extraction from Apollo database ended with errors." & vbCrLf & _
" Extracted data from " & num_rows & " row(s)."
End If

Exit Sub

Error_Handler:
HandleError "modApollo.DoExtractApollo()"
errors = True
GoTo Exit_Sub
End Sub
[/VBA]
the strexecution_broker must be the same as the GS_CPARTY code in order for it to retrive the GS_PARTY_ALPHA.

strexecution_broker and gs_CPARTY_code is the brokerid.
GS_CPARTY_ALPHa is the name of the broker. then using the gs_party_alpha it is compared to "%GIC". the first and the last character is compared with each other. when both character is not the same then only the information will be retrieved.

however strexecution_broker is from one db and gs_cparty_code and gs_cparty_alpha is from another db. below are the codes;

[VBA] Option Explicit

Public Function GetCpartyAndCpartyAlpha(connGems As adodb.Connection, _
cparty As String, cpartyalpha As String) _
As Boolean
Dim squery As String
Dim rs As New adodb.Recordset

'Build Query String
squery = "SELECT GS_CPARTY, GS_CPARTY_ALPHA FROM TBLGS_COUNTERPARTY"

'Execute Query
rs.ActiveConnection = connGems
rs.Open squery

If rs.EOF Then
cparty = Empty
cpartyalpha = Empty
Else
cparty = rs!GS_CPARTY
cpartyalpha = rs!GS_CPARTY_ALPHA
End If

GetCpartyAndCpartyAlpha = True

' Close recordset
rs.Close
End Function
[/VBA]
[VBA]
Public Function ExcludeIPT(connGems As adodb.Connection, cparty As String, _
cpartyalpha As String, executionbroker As String) _
As String
Dim i As Integer

If GetCpartyAndCpartyAlpha(connGems, cparty, cpartyalpha) Then
If executionbroker = cparty Then
If cparty.substring(i - 1, 1) <> executionbroker.substring(0, 1) Then
ExcludeIPT = executionbroker
End If
End If
End If
End Function
[/VBA]

under if cparty.substring(i-1, 1) is where i got the invalid qualifier error. help please!!

[acw]

Hi

As i is not initiated, it will default to 0. 0-1 becomes -1 so is invalid.


Tony