Dear Friends
For a study,
STEP 1:
I tried to lock certain cells in C column cell (which contains drop-down menus and its contents) if it’s approved by a cell in D column (Approval Syntax: TEYID ALINDI)
In this case, the file with the code worked fine. (Look: First Workbook as attached, You can see the codes)
STEP 2:
However, I tried to make an easy-search with inserting one or two character of list content in the drop-down menu (C Column). And I decided to implement an autocomplete feature. But due to Listbox/Textbox do not support autocomplete feature, I tried to convert Listbox/Textboxes (in C column) to combobox and I added a new code to convert.
STEP 3:
But, When I combined these two codes (Look : Second Workbook as attached), First code does not work and cells are not locked.
How could I fix it. Can you help?
(Applicable codes and sample files attached below)
Thanks
MD
FIRST CODE
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [c8:g100]) Is Nothing Then Exit Sub
ActiveSheet.Unprotect
Range("c8:g100").Locked = False
For sat = 8 To 100
If Cells(sat, "d") = "TEYID ALINDI" Then
Range(Cells(sat, "c"), Cells(sat, "d")).Locked = True
Else
Range(Cells(sat, "c"), Cells(sat, "d")).Locked = False
End If
If Cells(sat, "f") = "TEYID ALINDI" Then
Range(Cells(sat, "e"), Cells(sat, "f")).Locked = True
Else
Range(Cells(sat, "e"), Cells(sat, "f")).Locked = False
End If
Next
ActiveSheet.Protect
End Sub
COMBINED CODE:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [c8:g100]) Is Nothing Then
ActiveSheet.Unprotect
Else
ActiveSheet.Unprotect
Range("c8:g100").Locked = False
For sat = 8 To 100
If Cells(sat, "d") = "TEYID ALINDI" Then
Range(Cells(sat, "c"), Cells(sat, "d")).Locked = True
Else
Range(Cells(sat, "c"), Cells(sat, "d")).Locked = False
End If
If Cells(sat, "f") = "TEYID ALINDI" Then
Range(Cells(sat, "e"), Cells(sat, "f")).Locked = True
Else
Range(Cells(sat, "e"), Cells(sat, "f")).Locked = False
End If
Next
Call sel_change
'ActiveSheet.Protect
End If
End Sub
Private Sub TempCombo_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
'Combobox'i sakla, enter,tab ile cik
Select Case KeyCode
Case 9
ActiveCell.Offset(0, 1).Activate
Case 13
ActiveCell.Offset(1, 0).Activate
Case Else
'bos
End Select
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim metin As String
Dim Tempcombo As OLEObject
Dim sayfa As Worksheet
Dim sayfaListesi As Worksheet
Set sayfa = ActiveSheet
Set sayfaListesi = Sheets("PERSONEL")
Cancel = True
Set Tempcombo = sayfa.OLEObjects("TempCombo")
On Error Resume Next
With Tempcombo
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo Hata_tutucu
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
metin = Target.Validation.Formula1
metin = Right(metin, Len(metin) - 1)
With Tempcombo
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 5
.ListFillRange = metin
.LinkedCell = Target.Address
End With
Tempcombo.Activate
End If
Hata_tutucu:
Application.EnableEvents = True
Exit Sub
End Sub
Sub sel_change()
Dim metin As String
Dim Tempcombo As OLEObject
Dim sayfa As Worksheet
Set sayfa = ActiveSheet
Application.EnableEvents = False
Application.ScreenUpdating = False
If Application.CutCopyMode Then
'Sayfa uzerinde kopyala yapistir yapabilmek icin
GoTo Hata_tutucu
End If
Set Tempcombo = sayfa.OLEObjects("TempCombo")
On Error Resume Next
With Tempcombo
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
Hata_tutucu:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
End Sub
Bookmarks