+ Reply to Thread
Results 1 to 1 of 1

Combining vba codes makes the previous codes broken !

  1. #1
    Registered User
    Join Date
    03-26-2013
    Location
    NEW YORK
    MS-Off Ver
    Excel 2010 ENGLISH
    Posts
    1

    Combining vba codes makes the previous codes broken !

    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
    Attached Files Attached Files

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1