Wrox Programmer Forums

Need to download code?

View our list of code downloads.

Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
Password Reminder
Register
| FAQ | Members List | Calendar | Search | Today's Posts | Mark Forums Read
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 tens of thousands of software programmers and website developers including Wrox book authors and readers. As a guest, you can read any forum posting. By joining today you can post your own programming questions, respond to other developers’ questions, and eliminate the ads that are displayed to guests. Registration is fast, simple and absolutely free .
DRM-free e-books 300x50
Reply
 
Thread Tools Search this Thread Display Modes
  #1 (permalink)  
Old October 4th, 2005, 01:33 AM
Registered User
 
Join Date: Oct 2005
Location: , , .
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
Reply With Quote
  #2 (permalink)  
Old October 4th, 2005, 02:24 AM
Friend of Wrox
 
Join Date: Jan 2005
Location: Bournemouth, Dorset, United Kingdom.
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

Reply With Quote
  #3 (permalink)  
Old October 4th, 2005, 02:41 AM
Registered User
 
Join Date: Oct 2005
Location: , , .
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
Reply With Quote
  #4 (permalink)  
Old October 4th, 2005, 03:16 AM
Registered User
 
Join Date: Oct 2005
Location: , , .
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
Reply With Quote
  #5 (permalink)  
Old October 4th, 2005, 03:18 AM
Friend of Wrox
 
Join Date: Jan 2005
Location: Bournemouth, Dorset, United Kingdom.
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


Reply With Quote
  #6 (permalink)  
Old October 4th, 2005, 03:43 AM
Registered User
 
Join Date: Oct 2005
Location: , , .
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
Reply With Quote
  #7 (permalink)  
Old October 4th, 2005, 04:14 AM
Friend of Wrox
 
Join Date: Jan 2005
Location: Bournemouth, Dorset, United Kingdom.
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


Reply With Quote
  #8 (permalink)  
Old October 4th, 2005, 04:26 AM
Registered User
 
Join Date: Oct 2005
Location: , , .
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
Reply With Quote
  #9 (permalink)  
Old October 4th, 2005, 04:33 AM
Friend of Wrox
 
Join Date: Jan 2005
Location: Bournemouth, Dorset, United Kingdom.
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

Reply With Quote
  #10 (permalink)  
Old October 4th, 2005, 09:13 PM
Registered User
 
Join Date: Oct 2005
Location: , , .
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
Reply With Quote
Reply


Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

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


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



All times are GMT -4. The time now is 05:39 AM.


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