Hi,
I have designed a user-form from within the MS VB module of Excel. I have set up the form as required adjusted all the properties as required and have used the following vba code to make it work;
Private Sub CmdOk_Click()
ActiveWorkbook.Sheets("sheet2").Activate
Range("b2").Select
'to get down to the 1st empty row
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
'in order to put the correct age group into column B
If OptUnder18 = True Then
ActiveCell.Offset(0, 1).Value = "Under 18"
ElseIf Opt1864 = True Then
ActiveCell.Offset(0, 1).Value = "18-64"
ElseIf Opt6574 = True Then
ActiveCell.Offset(0, 1).Value = "65-74"
Else
ActiveCell.Offset(0, 1).Value = "75+"
End If
'selected values from the comboboxes get put into column C to I on the same row
ActiveCell.Offset(0, 2).cboClientCategory.Value
ActiveCell.Offset(0, 3).cboReferralType.Value
ActiveCell.Offset(0, 4).cboReferralSource.Value
ActiveCell.Offset(0, 5).cboReferralReason.Value
ActiveCell.Offset(0, 6).cboReferralReason2.Value
ActiveCell.Offset(0, 7).cboReferralReason3.Value
ActiveCell.Offset(0, 8).txtReferralReason.Value
'puts the selected ethnicity into column J
If OptWhiteBrit = True Then
ActiveCell.Offset(0, 9).Value = "White British"
ElseIf OptWhiteIrish = True Then
ActiveCell.Offset(0, 9).Value = "White Irish"
ElseIf OptWhiteOther = True Then
ActiveCell.Offset(0, 9).Value = "White Other"
ElseIf OptMixedCaribbean = True Then
ActiveCell.Offset(0, 9).Value = "Mixed Caribbean"
ElseIf OptMixedAfrican = True Then
ActiveCell.Offset(0, 9).Value = "Mixed African"
ElseIf OptMixedAsian = True Then
ActiveCell.Offset(0, 9).Value = "Mixed Asian"
ElseIf OptMixedOther = True Then
ActiveCell.Offset(0, 9).Value = "Mixed Other"
ElseIf OptAsianIndian = True Then
ActiveCell.Offset(0, 9).Value = "Asian Indian"
ElseIf OptAsianPakistani = True Then
ActiveCell.Offset(0, 9).Value = "Asian Pakistani"
ElseIf OptAsianOther = True Then
ActiveCell.Offset(0, 9).Value = "Asian Other"
ElseIf OptBlackCaribbean = True Then
ActiveCell.Offset(0, 9).Value = "Black Caribbean"
ElseIf OptBlackAfrican = True Then
ActiveCell.Offset(0, 9).Value = "Black African"
ElseIf OptBlackOther = True Then
ActiveCell.Offset(0, 9).Value = "Black Other"
ElseIf OptChinese = True Then
ActiveCell.Offset(0, 9).Value = "Chinese"
ElseIf OptChineseOther = True Then
ActiveCell.Offset(0, 9).Value = "Chinese Other"
ElseIf OptNotStated = True Then
ActiveCell.Offset(0, 9).Value = "Not Stated"
End If
'puts the FACS eligibility into column K of the sanme row
If OptLow = True Then
ActiveCell.Offset(0, 10).Value = "Low"
ElseIf OptModerate = True Then
ActiveCell.Offset(0, 10).Value = "Moderate"
ElseIf OptSubstantial = True Then
ActiveCell.Offset(0, 10).Value = "Substantial"
ElseIf OptCritical = True Then
ActiveCell.Offset(0, 10).Value = "Critical"
End If
'selected values from the comboboxes get put into column L to N on the same row
ActiveCell.Offset(0, 11) = cboOutcome1.Value
ActiveCell.Offset(0, 12) = cboOutcome2.Value
ActiveCell.Offset(0, 13) = cboOutcome3.Value
Range("B2").Select
End Sub
Private Sub CmdClear_Click()
Call UserForm_Initialize
End Sub
Private Sub CmdCancel_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
txtReferralReason.Value = ""
With cboClientCategory
.AddItem "Carers [Aged Under 18]"
.AddItem "Carers [Aged 18-64]"
.AddItem "Carers [Aged 65-74]"
.AddItem "Carers [Aged 75+]"
.AddItem "Older People (Not EMI) [Aged 65-74]"
.AddItem "Older People (Not EMI) [Aged 75+]"
.AddItem "Physical Disability/Sensory Impairment [Aged 18-64]"
.AddItem "Learning Disability [Aged 18-64]"
.AddItem "Mental Health / EMI [Aged 18-64]"
.AddItem "Mental Health / EMI [Aged 65-74]"
.AddItem "Mental Health / EMI [Aged 75+]"
.AddItem "Substance Misuse [Aged 18-64]"
.AddItem "Other Vulnerable People [Aged 18-64]"
End With
cboClientCategory.Value = ""
With cboReferralType
.AddItem "New Client"
.AddItem "1st Contact of year for an existing client"
.AddItem "Repeat (i.e. Subsequent contact within the year)"
End With
cboReferralType.Value = ""
With cboReferralSource
.AddItem "Primary/Community Health (GP's etc)"
.AddItem "Secondary Health (A&E, Hosptial, OT etc)"
.AddItem "Self Referral"
.AddItem "Family / Friend / Neighbour"
.AddItem "Sefton Social Services Dept"
.AddItem "LA Housing Dept or Housing Association"
.AddItem "Other Dept of Sefton LA or Other LA"
.AddItem "Legal Agency (Police, Court, Solicitor etc)"
.AddItem "Other"
.AddItem "Not Known"
End With
cboReferralSource.Value = ""
With cboReferralReason
.AddItem "Information & advice"
.AddItem "Accident prevention"
.AddItem "Security review"
.AddItem "Equipment & Adaptations"
.AddItem "Carer Support"
.AddItem "Other (please specify)"
End With
cboReferralReason.Value = ""
With cboReferralReason2
.AddItem "Information & advice"
.AddItem "Accident prevention"
.AddItem "Security review"
.AddItem "Equipment & Adaptations"
.AddItem "Carer Support"
.AddItem "Other (please specify)"
End With
cboReferralReason2.Value = ""
With cboReferralReason3
.AddItem "Information & advice"
.AddItem "Accident prevention"
.AddItem "Security review"
.AddItem "Equipment & Adaptations"
.AddItem "Carer Support"
.AddItem "Other (please specify)"
End With
cboReferralReason3.Value = ""
With cboOutcome1
.AddItem "Referral to other agency/organisation"
.AddItem "Provision of advice and information"
.AddItem "Promotion of independence"
.AddItem "Provision of equipment - Same Day"
.AddItem "Provision of equipment - Within 7 Days"
.AddItem "Provision of equipment - Within 3 Weeks"
.AddItem "Installation of adaptation"
.AddItem "Repairs undertaken"
.AddItem "Crime prevention"
.AddItem "Safety assessment"
.AddItem "Volunteers"
End With
cboOutcome1.Value = ""
With cboOutcome2
.AddItem "Referral to other agency/organisation"
.AddItem "Provision of advice and information"
.AddItem "Promotion of independence"
.AddItem "Provision of equipment - Same Day"
.AddItem "Provision of equipment - Within 7 Days"
.AddItem "Provision of equipment - Within 3 Weeks"
.AddItem "Installation of adaptation"
.AddItem "Repairs undertaken"
.AddItem "Crime prevention"
.AddItem "Safety assessment"
.AddItem "Volunteers"
End With
cboOutcome2.Value = ""
With cboOutcome3
.AddItem "Referral to other agency/organisation"
.AddItem "Provision of advice and information"
.AddItem "Promotion of independence"
.AddItem "Provision of equipment - Same Day"
.AddItem "Provision of equipment - Within 7 Days"
.AddItem "Provision of equipment - Within 3 Weeks"
.AddItem "Installation of adaptation"
.AddItem "Repairs undertaken"
.AddItem "Crime prevention"
.AddItem "Safety assessment"
.AddItem "Volunteers"
End With
cboOutcome3.Value = ""
OptUnder18 = False
Opt1864 = False
Opt6574 = False
Opt75 = False
OptWhiteBrit = False
OptWhiteIrish = False
OptWhiteOther = False
OptMixedCaribbean = False
OptMixedAfrican = False
OptMixedAsian = False
OptMixedOther = False
OptAsianIndian = False
OptAsianPakistani = False
OptAsianOther = False
OptBlackCaribbean = False
OptBlackAfrican = False
OptBlackOther = False
OptChinese = False
OptChineseOther = False
OptNotStated = False
OptSubstantial = False
OptModerate = False
OptCritical = False
End Sub
Display More
I then created a Word Art button on the worksheet that is supposed to bring up the form so that a user can begin inputing, the code i used to do this is on sheet2:
When i click on the button assigned to the open form macro i get a run-time error 70 "Permission Error". And the debugger highlights the following line of text in yellow:
I have checked the File, Permissions menu and it is set to unrestricted access.
Does anyone have any suggestions or a possible solution for this?
Id be extremely grateful if somebody could help me resolve this issue.
Regards
Damian