Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Events don't seem to trigger after deleting cell values | Excel Programming | |||
Disabling Events | Excel Programming | |||
Disabling Events | Excel Programming | |||
Time events to trigger VB (corrected) | Excel Programming | |||
Tim events to trigger VB programs | Excel Programming |