Wrox Programmer Forums
|
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old October 4th, 2005, 01:33 AM
Registered User
 
Join Date: Oct 2005
Posts: 7
Thanks: 0
Thanked 0 Times in 0 Posts
Default 2 errors to rectify

[u]FIRST ERROR</u>

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

[u]SECOND ERROR</u>

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
 
Old October 4th, 2005, 02:24 AM
Friend of Wrox
 
Join Date: Jan 2005
Posts: 180
Thanks: 0
Thanked 0 Times in 0 Posts
Default

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

 
Old October 4th, 2005, 02:41 AM
Registered User
 
Join Date: Oct 2005
Posts: 7
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Hey Matt, I tried out your solution but again the same error appear.

Best Regards,
Farina =P
 
Old October 4th, 2005, 03:16 AM
Registered User
 
Join Date: Oct 2005
Posts: 7
Thanks: 0
Thanked 0 Times in 0 Posts
Default

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
 
Old October 4th, 2005, 03:18 AM
Friend of Wrox
 
Join Date: Jan 2005
Posts: 180
Thanks: 0
Thanked 0 Times in 0 Posts
Default

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


 
Old October 4th, 2005, 03:43 AM
Registered User
 
Join Date: Oct 2005
Posts: 7
Thanks: 0
Thanked 0 Times in 0 Posts
Default

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
 
Old October 4th, 2005, 04:14 AM
Friend of Wrox
 
Join Date: Jan 2005
Posts: 180
Thanks: 0
Thanked 0 Times in 0 Posts
Default

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


 
Old October 4th, 2005, 04:26 AM
Registered User
 
Join Date: Oct 2005
Posts: 7
Thanks: 0
Thanked 0 Times in 0 Posts
Default

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
 
Old October 4th, 2005, 04:33 AM
Friend of Wrox
 
Join Date: Jan 2005
Posts: 180
Thanks: 0
Thanked 0 Times in 0 Posts
Default

I've sent you an email to the default Wrox Email address.

cheers

Matt

 
Old October 4th, 2005, 09:13 PM
Registered User
 
Join Date: Oct 2005
Posts: 7
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Anybody else who have any idea on how to solve this problems?

Many thanks in advance!

Best Regards,
Farina =P





Similar Threads
Thread Thread Starter Forum Replies Last Post
Errors AGS BOOK: Professional CSS: Cascading Style Sheets for Web Design 0 September 4th, 2005 01:09 PM
how to rectify this error abdul_owiusa ASP.NET 2.0 Basics 0 October 5th, 2004 06:31 AM
Can't get errors to display with <html:errors> michaeldill JSP Basics 0 August 2nd, 2004 01:47 PM
errors and fixing errors Droopy XML 0 August 26th, 2003 12:47 AM
Errors Errors DB Errors Ljhopkins VS.NET 2002/2003 0 July 15th, 2003 12:42 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.