View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
Paul Paul is offline
external usenet poster
 
Posts: 661
Default RefEdit Exit not firing

_Exit Code :
Private Sub SrcRef_Exit(ByVal Cancel As MSForms.ReturnBoolean)
nRangeOK = Valid_Range_Selection
Select Case nRangeOK
Case 0
' This changes the visible or enabled status of other controls on the form,
but removing it has no effect on the failure or otherwise
Call Set_Control_Status
Case 1
pCancel = True
Case 2
zDoIt = False
Unload Me
End Select
End Sub



Validation Code :
Function Valid_Range_Selection(Optional pMessage, Optional pPopulate)
' Valid_Range_Selection is the value returned to the calling code to
determine the validation and selection
' 0 - Validation OK
' 1 - Validation failed - user selected to retry
' 2 - Validation failed - user selected to cancel import
Valid_Range_Selection = 0
cErrorText = ""

' If zFirst = True And nSourceColumns = 1 And nSourceRows = 1 Then
' If zFirst = True Then
' Exit Function
' End If

If IsMissing(pMessage) Then pMessage = True
If IsMissing(pPopulate) Then pPopulate = True

nSourceCol = Selection.Column
nSourceColumns = Selection.Columns.Count
nSourceRows = Selection.Rows.Count

GoSub Check_Range_Size

GoSub Check_No_Blanks

GoSub Check_No_Duplicates

If Valid_Range_Selection = 0 And pPopulate = True Then
Call Populate_Source_Data_View
End If

If Valid_Range_Selection < 0 And pMessage = True Then
n = MsgBox(cErrorText, vbstop + vbOKOnly, "Table import")
Valid_Range_Selection = 1
End If
Exit Function

Check_Range_Size:
' Check that the range specified includes at least two columns and at least
two rows
If nSourceColumns < 2 Or nSourceRows < 2 Then
If Len(Trim(cErrorText)) < 0 Then cErrorText = cErrorText + Chr(13)
cErrorText = cErrorText + "Range must include at least two columns
and at least two rows"
Valid_Range_Selection = 1
End If
Return

Check_No_Blanks:
' Check that there are no blank column headers
lBlankErr = False
For nCols = nSourceCol To nSourceCol + nSourceColumns - 1
If IsEmpty(myData(0, nCols - nSourceCol)) And lBlankErr = False Then
If Len(Trim(cErrorText)) < 0 Then cErrorText = cErrorText +
Chr(13)
cErrorText = cErrorText + "Column headers cannot be blank"
lBlankErr = True
Valid_Range_Selection = 1
End If
Next
Return

Check_No_Duplicates:
' Check that there are no duplicate column headers
lDuplicate = False
For nCols = nSourceCol To nSourceCol + nSourceColumns - 1
For nCols2 = nSourceCol To nSourceCol + nSourceColumns - 1
If myData(0, nCols - nSourceCol) = myData(0, nCols2 -
nSourceCol) _
And nCols < nCols2 And lDuplicate = False Then
If Len(Trim(cErrorText)) < 0 Then cErrorText =
cErrorText + Chr(13)
cErrorText = cErrorText + "Column headers cannot be
duplicated"
lDuplicate = True
Valid_Range_Selection = 1
End If
Next
Next
Return

End Function



--
If the post is helpful, please consider donating something to an animal
charity on my behalf.


"Paul" wrote:

Hi OssieMac

I'm using XL2003
Reference style is A1:B2
I have tried with the validation code within the _Exit sub
Modal is set to True

I'll post the code once I've stripped out the comments (otherwise there's
pages !!)




--
If the post is helpful, please consider donating something to an animal
charity on my behalf.


"OssieMac" wrote:

Hi again Paul,

I have managed to lock up the system by calling another sub. It appears to
be loosing a connection and/or reference between the objects when calling
subs.

A few questions and comments.

What version of xl are you using? (I have been testing in xl2007 but I also
have xl2002 and can get access to xl2003 at times.)

What reference style are you using? (A1:B2 etc or R1C1 style because R1C1
has problems.

Have you tried putting the validation code in the Private Sub SrcRef_Exit
instead of calling another routine? With my testing it appears to work
probably because it does not loose the connections between objects.

Modeless forms also cause lockups. Need to have showModal property = true
(or when showing the form with code it must be modal.)

Can you post the code you are using for the validation then perhaps I can do
some further testing.

Any errors in the code do not necessary cause the code to stop at the error.
It either ignores the sub and it does not run or locks up the system.
Therefore compile all code before running. (click on Debug - compile.)

--
Regards,

OssieMac