Microsoft runtime overflow error 6

  • Thread starter Thread starter Quay Qi Jing
  • Start date Start date
Q

Quay Qi Jing

Guest
I have a hard time figuring this , could anyone help me out please


Option Explicit

Sub CU_A_AddRec2()

If IsCorrectWorksheet(Sheets("Custodian (A)")) = False Then

MsgBox "Please select Custodian (A) worksheet first"

Exit Sub

End If

frmNum.Show

End Sub



Sub CU_A_AddRec()

If IsCorrectWorksheet(Sheets("Custodian (A)")) = False Then

MsgBox "Please select Custodian (A) worksheet first"

Exit Sub

End If



Call UnlockActiveSheet(PWD)

Dim lngFirstRow As Long

Dim lngLastRow As Long

Dim lngCurrRow As Long

Dim lngNextRow As Long



lngFirstRow = GetFirstRowNo(ActiveSheet, "ROWSTART")

lngLastRow = GetLastRowNo(ActiveSheet, "ROWEND")

lngCurrRow = ActiveCell.row



If lngCurrRow > lngFirstRow And lngCurrRow < lngLastRow Then

Range(Cells(lngFirstRow + 1, 1), Cells(lngFirstRow + 1, 20)).Select

lngNextRow = lngCurrRow + 1



Selection.EntireRow.Copy

Cells(lngNextRow, 1).Select

Selection.EntireRow.Insert

Call ResetRec(lngNextRow, 1, 19)

Else

MsgBox "Cannot insert new row"

End If



Call GenSeqNo

Call LockActiveSheet(PWD)

End Sub



Sub CU_A_DelRec()

If IsCorrectWorksheet(Sheets("Custodian (A)")) = False Then

MsgBox "Please Select Custodian (A) worksheet first"

Exit Sub

End If



Call UnlockActiveSheet(PWD)



Dim lngFirstRow As Long

Dim lngLastRow As Long

Dim lngCurrRow As Long

Dim lngNextRow As Long



lngFirstRow = GetFirstRowNo(ActiveSheet, "ROWSTART")

lngLastRow = GetLastRowNo(ActiveSheet, "ROWEND")

lngCurrRow = ActiveCell.row



If lngCurrRow > lngFirstRow And lngCurrRow < lngLastRow Then

If lngLastRow - lngFirstRow > 2 Then

Range(Cells(lngCurrRow, 1), Cells(lngCurrRow, 20)).Select

Selection.EntireRow.Delete

Else

Call ResetRec(lngCurrRow, 1, 19)

End If

Else

MsgBox "Please select a record"

End If



Call GenSeqNo

Call LockActiveSheet(PWD)

End Sub



Private Function CU_A_ValidDatItm(DatItm As Object)

CU_A_ValidDatItm = True

If Not (DatItm.Value = "1" Or DatItm.Value = "2" Or _

DatItm.Value = "3" Or DatItm.Value = "4") Then

CU_A_ValidDatItm = False

End If

End Function



Private Function CU_A_ValidPurCde(DatItm As Object, PurCde As Object)



CU_A_ValidPurCde = True



If DatItm.Value = "1" Then

If Not (Left(PurCde.Value, 5) = "36130") Then

CU_A_ValidPurCde = False

End If

End If

If DatItm.Value = "2" Then

If Not (Left(PurCde.Value, 5) = "36230" Or Left(PurCde.Value, 5) = "36420") Then

CU_A_ValidPurCde = False

End If

End If

If DatItm.Value = "3" Then

If Not (Left(PurCde.Value, 5) = "36330") Then

CU_A_ValidPurCde = False

End If

End If

If DatItm.Value = "4" Then

If Not (Left(PurCde.Value, 5) = "31310") Then

CU_A_ValidPurCde = False

End If

End If

End Function



Sub CU_A_Verify()

If IsCorrectWorksheet(Sheets("Custodian (A)")) = False Then

MsgBox "Please Select Custodian (A) worksheet first"

Exit Sub

End If



Application.ScreenUpdating = True

With frmVerifyResult

.lblSheetName = ActiveSheet.Name

.lblStatus.Caption = "In Progress ..."

.lblStatus.ForeColor = vbBlack

.txtMessage.Value = ""

End With



Dim lngFirstRow As Long

Dim lngLastRow As Long

Dim lngCurrRow As Long



Dim bolError As Boolean

Dim strErrMsg As String

Dim wf As Object



Dim objDatItm As Object

Dim objPurCde As Object



'ISIN PROFILE

Dim objISINInd As Object

Dim objISINCde As Object

Dim objISINIssNm As Object

Dim objISINIssrNm As Object

Dim objISINIssrCtr As Object

Dim objISINIssrSec As Object



Dim objResSec As Object

Dim objComRef As Object

Dim objCurCde As Object



'REPORT IN FC

Dim objFCOpen As Object

Dim objFCTrxDR As Object

Dim objFCTrxCR As Object

Dim objFCAdjPri As Object

Dim objFCAdjOth As Object

Dim objFCClose As Object

Dim objDescre As Object



Dim lngCaldes As Long



lngFirstRow = GetFirstRowNo(ActiveSheet, "ROWSTART")

lngLastRow = GetLastRowNo(ActiveSheet, "ROWEND")

lngCurrRow = lngFirstRow + 1

bolError = False

Set wf = Application.WorksheetFunction



Do While lngCurrRow < lngLastRow



If haveDetail(lngCurrRow, 3, 19) = True Then

Set objDatItm = Cells(lngCurrRow, 3)

Set objPurCde = Cells(lngCurrRow, 4)

Set objISINInd = Cells(lngCurrRow, 5)

Set objISINCde = Cells(lngCurrRow, 6)

Set objISINIssNm = Cells(lngCurrRow, 7)

Set objISINIssrNm = Cells(lngCurrRow, 8)

Set objISINIssrCtr = Cells(lngCurrRow, 9)

Set objISINIssrSec = Cells(lngCurrRow, 10)

Set objResSec = Cells(lngCurrRow, 11)

Set objComRef = Cells(lngCurrRow, 12)

Set objCurCde = Cells(lngCurrRow, 13)

Set objFCOpen = Cells(lngCurrRow, 14)

Set objFCTrxDR = Cells(lngCurrRow, 15)

Set objFCTrxCR = Cells(lngCurrRow, 16)

Set objFCAdjPri = Cells(lngCurrRow, 17)

Set objFCAdjOth = Cells(lngCurrRow, 18)

Set objFCClose = Cells(lngCurrRow, 19)

Set objDescre = Cells(lngCurrRow, 20)



objDatItm.Value = Trim(objDatItm.Value)

objPurCde.Value = Trim(objPurCde.Value)

objISINInd.Value = Trim(UCase(objISINInd.Value))

objISINCde.Value = Trim(UCase(objISINCde.Value))

objISINIssNm.Value = Trim(UCase(objISINIssNm.Value))

objISINIssrNm.Value = Trim(UCase(objISINIssrNm.Value))

objISINIssrCtr.Value = Trim(objISINIssrCtr.Value)

objISINIssrSec.Value = Trim(objISINIssrSec.Value)

objResSec.Value = Trim(objResSec.Value)

objComRef.Value = Trim(UCase(objComRef.Value))

objCurCde.Value = Trim(objCurCde.Value)



If objDatItm.Value = "" Then

strErrMsg = "Error at " & RemDollar(objDatItm.Address) & ", Type of Data Item" & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If



If objPurCde.Value = "" Then

strErrMsg = "Error at " & RemDollar(objPurCde.Address) & ", Purpose Code" & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If



If objDatItm.Value <> "" And objPurCde.Value <> "" Then

If CU_A_ValidDatItm(objDatItm) Then

If CU_A_ValidPurCde(objDatItm, objPurCde) Then

'************ Custodian : Assets > Verifying Record - start ************

'Checking for mandatory fields

If chkIsNull(objISINInd) Then

strErrMsg = "Error at " & RemDollar(objISINInd.Address) & ", Indicator of ISIN Code/Security Ref. No." & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If

If chkIsNull(objISINCde) Then

strErrMsg = "Error at " & RemDollar(objISINCde.Address) & ", ISIN Code/ Security Ref. No." & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If



If (Not chkIsNull(objISINCde)) And (Not chkIsNull(objISINInd)) Then

If Len(objISINCde.Value) <> 12 And objISINInd.Value = "Y" Then

strErrMsg = "Error at " & RemDollar(objISINCde.Address) & ", length of ISIN code must be 12 characters"

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If

If Len(objISINCde.Value) > 50 And objISINInd.Value = "N" Then

strErrMsg = "Error at " & RemDollar(objISINCde.Address) & ", length of Securities Ref. No. must not more than 50 characters"

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If

End If



If chkIsNull(objISINIssNm) Then

strErrMsg = "Error at " & RemDollar(objISINIssNm.Address) & ", Name of Issue" & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If



If chkIsNull(objISINIssrNm) Then

strErrMsg = "Error at " & RemDollar(objISINIssrNm.Address) & ", Name of Issuer" & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If



If chkIsNull(objISINIssrCtr) Then

strErrMsg = "Error at " & RemDollar(objISINIssrCtr.Address) & ", Issuer Country" & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

Else

If Left(objISINIssrCtr.Value, 2) = "MY" Then

strErrMsg = "Error at " & RemDollar(objISINIssrCtr.Address) & ", Issuer Country must NOT be MY"

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If

End If



If chkIsNull(objISINIssrSec) Then

strErrMsg = "Error at " & RemDollar(objISINIssrSec.Address) & ", Issuer Institutional Sector" & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

Else

If Left(objPurCde.Value, 5) = "36420" And (Not (Left(objISINIssrSec.Value, 2) = "GV" Or Left(objISINIssrSec.Value, 2) = "PC")) Then

strErrMsg = "Error at " & RemDollar(objISINIssrSec.Address) & ", Issuer Institutional Sector must be GV or PC"

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If

End If



If chkIsNull(objResSec) Then

strErrMsg = "Error at " & RemDollar(objResSec.Address) & ", Resident Clients by Institutional Sector" & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If



If chkIsNull(objCurCde) Then

strErrMsg = "Error at " & RemDollar(objCurCde.Address) & ", Currency Code" & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If



If Not chkIsNull(objFCOpen) Then

If chkIsNull(objFCOpen) Then

strErrMsg = "Error at " & RemDollar(objFCOpen.Address) & ", Opening Position" & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

ElseIf Not wf.IsNumber(objFCOpen.Value) Then

strErrMsg = "Error at " & RemDollar(objFCOpen.Address) & ", Opening Position" & ErrMsgNumeric

Call WriteMsgToScreen(strErrMsg)

bolError = True

ElseIf Not (Left(objPurCde.Value, 5) = "14130" Or Left(objPurCde.Value, 5) = "39210" Or _

Left(objPurCde.Value, 5) = "39220" Or Left(objPurCde.Value, 5) = "39230" Or _

Left(objPurCde.Value, 5) = "31210" Or Left(objPurCde.Value, 5) = "31220" Or _

Left(objPurCde.Value, 5) = "39900") Then

If objFCOpen.Value < 0 Then

strErrMsg = "Error at " & RemDollar(objFCOpen.Address) & ", Opening Position" & ErrMsgPositive

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If

End If

Else

objFCOpen.Value = "0.00"

End If



If Not chkIsNull(objFCTrxDR) Then

If chkIsNull(objFCTrxDR) Then

strErrMsg = "Error at " & RemDollar(objFCTrxDR.Address) & ", Debit Transaction (Outflow)" & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

ElseIf Not wf.IsNumber(objFCTrxDR.Value) Then

strErrMsg = "Error at " & RemDollar(objFCTrxDR.Address) & ", Debit Transaction (Outflow)" & ErrMsgNumeric

Call WriteMsgToScreen(strErrMsg)

bolError = True

ElseIf objFCTrxDR.Value < 0 Then

strErrMsg = "Error at " & RemDollar(objFCTrxDR.Address) & ", Debit Transaction (Outflow)" & ErrMsgPositive

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If

Else

objFCTrxDR.Value = "0.00"

End If



If Not chkIsNull(objFCTrxCR) Then

If chkIsNull(objFCTrxCR) Then

strErrMsg = "Error at " & RemDollar(objFCTrxCR.Address) & ", Credit Transaction (Inflow)" & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

ElseIf Not wf.IsNumber(objFCTrxCR.Value) Then

strErrMsg = "Error at " & RemDollar(objFCTrxCR.Address) & ", Credit Transaction (Inflow)" & ErrMsgNumeric

Call WriteMsgToScreen(strErrMsg)

bolError = True

ElseIf objFCTrxCR.Value < 0 Then

strErrMsg = "Error at " & RemDollar(objFCTrxCR.Address) & ", Credit Transaction (Inflow)" & ErrMsgPositive

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If

Else

objFCTrxCR.Value = "0.00"

End If



If Not chkIsNull(objFCAdjPri) Then

If chkIsNull(objFCAdjPri) Then

strErrMsg = "Error at " & RemDollar(objFCAdjPri.Address) & ", Adjustment on Price Changes" & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

ElseIf Not wf.IsNumber(objFCAdjPri.Value) Then

strErrMsg = "Error at " & RemDollar(objFCAdjPri.Address) & ", Adjustment on Price Changes" & ErrMsgNumeric

Call WriteMsgToScreen(strErrMsg)

bolError = True

'ElseIf objFCAdjPri.Value < 0 Then

'strErrMsg = "Error at " & RemDollar(objFCAdjPri.Address) & ", Adjustment on Price Changes" & ErrMsgPositive

'Call WriteMsgToScreen(strErrMsg)

'bolError = True

End If

Else

objFCAdjPri.Value = "0.00"

End If



If Not chkIsNull(objFCAdjOth) Then

If chkIsNull(objFCAdjOth) Then

strErrMsg = "Error at " & RemDollar(objFCAdjOth.Address) & ", Adjustment on Other Changes" & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

ElseIf Not wf.IsNumber(objFCAdjOth.Value) Then

strErrMsg = "Error at " & RemDollar(objFCAdjOth.Address) & ", Adjustment on Other Changes" & ErrMsgNumeric

Call WriteMsgToScreen(strErrMsg)

bolError = True

'ElseIf objFCAdjOth.Value < 0 Then

'strErrMsg = "Error at " & RemDollar(objFCAdjOth.Address) & ", Adjustment on Other Changes" & ErrMsgPositive

'Call WriteMsgToScreen(strErrMsg)

'bolError = True

End If

Else

objFCAdjOth.Value = "0.00"

End If



If Not chkIsNull(objFCClose) Then

If chkIsNull(objFCClose) Then

strErrMsg = "Error at " & RemDollar(objFCClose.Address) & ", Closing Position" & ErrMsgNotNull

Call WriteMsgToScreen(strErrMsg)

bolError = True

ElseIf Not wf.IsNumber(objFCClose.Value) Then

strErrMsg = "Error at " & RemDollar(objFCClose.Address) & ", Closing Position" & ErrMsgNumeric

Call WriteMsgToScreen(strErrMsg)

bolError = True

ElseIf Not (Left(objPurCde.Value, 5) = "14130" Or Left(objPurCde.Value, 5) = "39210" Or _

Left(objPurCde.Value, 5) = "39220" Or Left(objPurCde.Value, 5) = "39230" Or _

Left(objPurCde.Value, 5) = "31210" Or Left(objPurCde.Value, 5) = "31220" Or _

Left(objPurCde.Value, 5) = "39900") Then

If objFCClose.Value < 0 Then

strErrMsg = "Error at " & RemDollar(objFCClose.Address) & ", Closing Position" & ErrMsgPositive

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If

End If

Else

objFCClose.Value = "0.00"

End If



If objDescre.Value <> 0 Then

If Not (objDescre.Value > -0.0001 And objDescre.Value < 0.0001) Then

strErrMsg = "Discrepancy amount at line " & lngCurrRow

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If

End If



'CALC DESCRE

lngCaldes = objFCClose.Value - objFCOpen.Value - (objFCTrxDR.Value - objFCTrxCR.Value + objFCAdjPri.Value + objFCAdjOth.Value)

'ActiveSheet.Unprotect Password:=PWD

'objDescre.Value = lngCalDes

'ActiveSheet.Protect Password:=PWD

'************ Custodian : Assets > Verifying Record - end ************

Else

strErrMsg = "Error at " & RemDollar(objPurCde.Address) & ", " & ErrMsgInvalidPurCde

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If

Else

strErrMsg = "Error at " & RemDollar(objDatItm.Address) & ", " & ErrMsgInvalidDatItm

Call WriteMsgToScreen(strErrMsg)

bolError = True

End If

End If

End If

lngCurrRow = lngCurrRow + 1

Loop



If bolError = True Then

With frmVerifyResult

.lblStatus.Caption = "Failed"

.lblStatus.ForeColor = vbRed

.Show

End With

Else

With frmVerifyResult

.lblStatus.Caption = "Verification is Done!"

.lblStatus.ForeColor = &H8000&

'.Show

End With

End If

End Sub


The highlighted line is lngCaldes = objFCClose.Value - objFCOpen.Value - (objFCTrxDR.Value - objFCTrxCR.Value + objFCAdjPri.Value + objFCAdjOth.Value)

Continue reading...
 
Back
Top