T
Tachyon
I have a problem with the code below. Now I've only been doing this VBA
stuff for a few days and I got the code for the Combobox from elsewhere
It works 'pretty well' but certain things don't happen - for starters, it
doesn't ever enter the Sub TempCombo_KeyDown subroutine, and it doesn't hide
the Combobox if you double click in it.
I'm not sure if this code will make any sense to anyone else. Either that
or it will be blatently obvious to an experienced person - probably the later!
I think I need to know more about triggers and what happens when I say -
Application.EnableEvents = False.
Any help would be much appreciated - and anything else you care to comment on.
Thanks 'very' much.
--
Tachyon
Option Explicit
Private Sub TempCombo_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
'Hide combo box and move to next cell on Enter and Tab
Select Case KeyCode
Case 9
ActiveCell.Offset(0, 1).Activate
Case 13
ActiveCell.Offset(3, 0).Activate
Case Else
'do nothing
End Select
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Cancel = True
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 5
.ListFillRange = ws.Range(str).Address
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
If cboTemp.Visible = True Then
With cboTemp
.Top = 10
.Left = 10
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
Dim MRange As Range
Set MRange = Range("InputRange")
If Intersect(Target, MRange) Is Nothing Then _
Exit Sub
Dim OrigValue, PrefixValue, LookupResult, x, SuffixValue, Phrase, Bond,
SpecAction
Application.EnableEvents = False
On Error GoTo ErrorHandler
OrigValue = Target.Value
If LCase(Right(OrigValue, 1)) = "n" Or LCase(Right(OrigValue, 1)) = "l" Then _
SpecAction = Right(OrigValue, 1)
PrefixValue = Left(OrigValue, 3)
SuffixValue = Right(OrigValue, Len(OrigValue) - 3)
LookupResult = Application.WorksheetFunction.VLookup(PrefixValue,
Sheet2.Range("TypeList"), 2, False)
For x = 0 To 6
Selection.Offset(0, x).Range("A1") =
Application.WorksheetFunction.VLookup(PrefixValue, Sheet2.Range("TypeList"),
x + 2, False)
Next x
Select Case LookupResult
Case "ECG"
Phrase = Application.WorksheetFunction.VLookup(LookupResult,
Sheet2.Range("EquipData"), 2, False)
Phrase = Application.WorksheetFunction.Substitute(Phrase, "EB",
IIf(Left(SuffixValue, 1) = "0", Right(Left(SuffixValue, 3), 2),
Left(SuffixValue, 3)))
Phrase = Application.WorksheetFunction.Substitute(Phrase, "EL",
Mid(SuffixValue, 4, 1) & "." & Mid(SuffixValue, 5, 2))
Phrase = Application.WorksheetFunction.Substitute(Phrase, "PC1",
Mid(SuffixValue, 7, 1) & "." & Mid(SuffixValue, 8, 2))
Phrase = Application.WorksheetFunction.Substitute(Phrase, "PC2",
Mid(SuffixValue, 10, 1) & "." & Mid(SuffixValue, 11, 2))
Phrase = Application.WorksheetFunction.Substitute(Phrase, "PC3",
Mid(SuffixValue, 13, 1) & "." & Mid(SuffixValue, 14, 2))
Selection.Offset(0, 5).Range("A1") = Phrase
Case "Nebuliser"
Phrase = Application.WorksheetFunction.VLookup(LookupResult,
Sheet2.Range("EquipData"), 2, False)
Phrase = Application.WorksheetFunction.Substitute(Phrase, "FR",
IIf(Left(SuffixValue, 1) = "0", Right(Left(SuffixValue, 2), 1),
Left(SuffixValue, 2)) & "." & Mid(SuffixValue, 3, 1))
Phrase = Application.WorksheetFunction.Substitute(Phrase, "PR",
IIf(Mid(SuffixValue, 4, 1) = "0", Mid(SuffixValue, 5, 1), Mid(SuffixValue, 4,
2)) & "." & Right(SuffixValue, 1))
Selection.Offset(0, 5).Range("A1") = Phrase
Case Else
0
End Select
Select Case LCase(SpecAction)
Case "n"
ActiveCell.Offset(0, 5).Select
Case "l"
ActiveCell.Offset(0, 4).Select
Case Else
ActiveCell.Offset(1, -1).Select
End Select
ErrorHandler:
Application.EnableEvents = True
End Sub
stuff for a few days and I got the code for the Combobox from elsewhere
It works 'pretty well' but certain things don't happen - for starters, it
doesn't ever enter the Sub TempCombo_KeyDown subroutine, and it doesn't hide
the Combobox if you double click in it.
I'm not sure if this code will make any sense to anyone else. Either that
or it will be blatently obvious to an experienced person - probably the later!
I think I need to know more about triggers and what happens when I say -
Application.EnableEvents = False.
Any help would be much appreciated - and anything else you care to comment on.
Thanks 'very' much.
--
Tachyon
Option Explicit
Private Sub TempCombo_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
'Hide combo box and move to next cell on Enter and Tab
Select Case KeyCode
Case 9
ActiveCell.Offset(0, 1).Activate
Case 13
ActiveCell.Offset(3, 0).Activate
Case Else
'do nothing
End Select
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Cancel = True
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 5
.ListFillRange = ws.Range(str).Address
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
If cboTemp.Visible = True Then
With cboTemp
.Top = 10
.Left = 10
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
Dim MRange As Range
Set MRange = Range("InputRange")
If Intersect(Target, MRange) Is Nothing Then _
Exit Sub
Dim OrigValue, PrefixValue, LookupResult, x, SuffixValue, Phrase, Bond,
SpecAction
Application.EnableEvents = False
On Error GoTo ErrorHandler
OrigValue = Target.Value
If LCase(Right(OrigValue, 1)) = "n" Or LCase(Right(OrigValue, 1)) = "l" Then _
SpecAction = Right(OrigValue, 1)
PrefixValue = Left(OrigValue, 3)
SuffixValue = Right(OrigValue, Len(OrigValue) - 3)
LookupResult = Application.WorksheetFunction.VLookup(PrefixValue,
Sheet2.Range("TypeList"), 2, False)
For x = 0 To 6
Selection.Offset(0, x).Range("A1") =
Application.WorksheetFunction.VLookup(PrefixValue, Sheet2.Range("TypeList"),
x + 2, False)
Next x
Select Case LookupResult
Case "ECG"
Phrase = Application.WorksheetFunction.VLookup(LookupResult,
Sheet2.Range("EquipData"), 2, False)
Phrase = Application.WorksheetFunction.Substitute(Phrase, "EB",
IIf(Left(SuffixValue, 1) = "0", Right(Left(SuffixValue, 3), 2),
Left(SuffixValue, 3)))
Phrase = Application.WorksheetFunction.Substitute(Phrase, "EL",
Mid(SuffixValue, 4, 1) & "." & Mid(SuffixValue, 5, 2))
Phrase = Application.WorksheetFunction.Substitute(Phrase, "PC1",
Mid(SuffixValue, 7, 1) & "." & Mid(SuffixValue, 8, 2))
Phrase = Application.WorksheetFunction.Substitute(Phrase, "PC2",
Mid(SuffixValue, 10, 1) & "." & Mid(SuffixValue, 11, 2))
Phrase = Application.WorksheetFunction.Substitute(Phrase, "PC3",
Mid(SuffixValue, 13, 1) & "." & Mid(SuffixValue, 14, 2))
Selection.Offset(0, 5).Range("A1") = Phrase
Case "Nebuliser"
Phrase = Application.WorksheetFunction.VLookup(LookupResult,
Sheet2.Range("EquipData"), 2, False)
Phrase = Application.WorksheetFunction.Substitute(Phrase, "FR",
IIf(Left(SuffixValue, 1) = "0", Right(Left(SuffixValue, 2), 1),
Left(SuffixValue, 2)) & "." & Mid(SuffixValue, 3, 1))
Phrase = Application.WorksheetFunction.Substitute(Phrase, "PR",
IIf(Mid(SuffixValue, 4, 1) = "0", Mid(SuffixValue, 5, 1), Mid(SuffixValue, 4,
2)) & "." & Right(SuffixValue, 1))
Selection.Offset(0, 5).Range("A1") = Phrase
Case Else
0
End Select
Select Case LCase(SpecAction)
Case "n"
ActiveCell.Offset(0, 5).Select
Case "l"
ActiveCell.Offset(0, 4).Select
Case Else
ActiveCell.Offset(1, -1).Select
End Select
ErrorHandler:
Application.EnableEvents = True
End Sub