Results 1 to 8 of 8

Thread: How do i run two VBA codes on one worksheet

  1. #1

    How do i run two VBA codes on one worksheet



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hi I have one code placed in my worksheet that's give me the facility to have a combo box that when clicked on open a pick list on another sheet and enter it into the cell, it also allows me to see a larger font and a longer list to pick from the first code is as follows

    -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Dim ws As Worksheet
    Dim str As String
    Dim i As Integer
    Dim rngDV As Range
    Dim rng As Range
    Dim strMsg As String
    Dim lRsp As Long
    strMsg = "Add this item to the list?"
    If Target.Count > 1 Then Exit Sub
    Set ws = Worksheets("Lists")

    If Target.Row > 1 Then
    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo 0
    If rngDV Is Nothing Then Exit Sub

    If Intersect(Target, rngDV) Is Nothing Then Exit Sub
    If Target = "" Then Exit Sub

    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
    On Error Resume Next
    Set rng = ws.Range(str)
    On Error GoTo 0
    If rng Is Nothing Then Exit Sub

    If Application.WorksheetFunction _
    .CountIf(rng, Target.Value) Then
    Exit Sub
    Else
    lRsp = MsgBox(strMsg, vbQuestion + vbYesNo, "Add New Item?")
    If lRsp = vbYes Then
    i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1
    ws.Cells(i, rng.Column).Value = Target.Value
    rng.Sort Key1:=ws.Cells(1, rng.Column), _
    Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom
    End If
    End If
    End If
    End Sub
    Private Sub TempCombo_KeyDown(ByVal _
    KeyCode As MSForms.ReturnInteger, _
    ByVal Shift As Integer)

    On Error Resume Next
    Dim ws As Worksheet
    Dim str As String
    Dim i As Integer
    Dim rngDV As Range
    Dim rng As Range
    Dim strMsg As String
    Dim lRsp As Long
    Dim c As Range
    strMsg = "Add this item to the list?"
    Set ws = Worksheets("Lists")
    Set c = ActiveCell

    str = c.Validation.Formula1
    str = Right(str, Len(str) - 1)
    On Error Resume Next
    Set rng = ws.Range(str)
    On Error GoTo 0
    If rng Is Nothing Then Exit Sub

    Select Case KeyCode
    Case 9
    c.Offset(0, 1).Activate
    If c.Value = "" Then Exit Sub
    If Application.WorksheetFunction _
    .CountIf(rng, c.Value) Then
    Exit Sub
    Else
    lRsp = MsgBox(strMsg, vbQuestion + vbYesNo, "Add New Item?")
    If lRsp = vbYes Then
    i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1
    ws.Cells(i, rng.Column).Value = c.Value
    rng.Sort Key1:=ws.Cells(1, rng.Column), _
    Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom
    End If
    End If
    Case 13
    c.Offset(1, 0).Activate
    If c.Value = "" Then Exit Sub
    If Application.WorksheetFunction _
    .CountIf(rng, c.Value) Then
    Exit Sub
    Else
    lRsp = MsgBox(strMsg, vbQuestion + vbYesNo, "Add New Item?")
    If lRsp = vbYes Then
    i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1
    ws.Cells(i, rng.Column).Value = c.Value
    rng.Sort Key1:=ws.Cells(1, rng.Column), _
    Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom
    End If
    End If
    Case Else
    'do nothing
    End Select
    End Sub
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim str As String
    Dim cboTemp As OLEObject
    Dim ws As Worksheet
    Dim wsList As Worksheet
    Dim rng As Range
    Dim i As Integer
    Dim strMsg As String
    Dim lRsp As Long
    Set ws = ActiveSheet
    Set wsList = Sheets("Lists")
    Set cboTemp = ws.OLEObjects("TempCombo")
    strMsg = "Add this item to the list?"
    If Target.Count > 1 Then GoTo exitHandler
    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 = str
    .LinkedCell = Target.Address
    End With

    cboTemp.Activate
    End If

    exitHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
    errHandler:
    Resume exitHandler
    End Sub


    The second code is to make a comment box when clicked on display to the left of the cell

    ----------------------------------------------------------------------------------------------------------------------------------------------------------------------

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
    If Not Target.Comment Is Nothing Then
    With Target.Comment.Shape
    .Left = Target.Left - .Width - 10
    .Top = Target.Offset(1).Top
    End With
    End If
    End If
    End Sub

    I can get both to work one at a time but no both together

    Is it possible to have both codes on one work sheet please

  2. #2
    Acolyte patel's Avatar
    Join Date
    Feb 2014
    Location
    Italy
    Posts
    59
    Articles
    0
    attach please a sample file for testing

  3. #3
    Hi thank you or the reply to my question I have encoded two sample files. sample data1 is a macro enabled excel 2010 file and sample Data2 is a excel 97-2007 excel file

    As you will be able to see if you click on ether of the combo boxes I get a pick list that has larger font and the list is longer then the normal excel pick list


    Bu my problem is I would like to add this second code below

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
    If Not Target.Comment Is Nothing Then
    With Target.Comment.Shape
    .Left = Target.Left - .Width - 10
    .Top = Target.Offset(1).Top
    End With
    End If
    End If
    End Sub

    This code makes any comment box when clicked on it display to the left of the cell and one row down

    But when I add this code the combo boxes revert back to the normal small font an only 8 lines showing in the pick list

    Hope you can help me

    Regards Edward
    Attached Files Attached Files
    Last edited by sam2149; 2014-02-27 at 08:53 AM.

  4. #4
    Ps I must have done something wrong in the upload of the sample files as they will not open any idea what I have done wrong

  5. #5
    Acolyte patel's Avatar
    Join Date
    Feb 2014
    Location
    Italy
    Posts
    59
    Articles
    0
    I can read the 2 attached file, but I'm not sure your approach is correct, can you explain me your goal ?

  6. #6
    Hi my goal is to have the combo boxes show me a larger font and a longer list to pick from, as you will be able to see. the default excel pick list is a very small font and it only shows 8 lines and then you have to scroll down to see the rest. with the code that's in the sample fie I can get the result I need.

    But the worksheet I need to use there are quite a few columns and I have one column right on the far right of my screen with some cells with comments in them, and when I hover the mouse over them they open but display to the right of the cell and go of the screen.

    The second code alters this and makes the comment box once clicked on display to the left and one row down and this is what I am trying to do.

    I have merged both codes and I get the comment box displaying as I want but the combo box reverts back to the excel default list with only 8 lines and a very small text

    Regards

  7. #7
    Acolyte patel's Avatar
    Join Date
    Feb 2014
    Location
    Italy
    Posts
    59
    Articles
    0
    I'm sorry but I can not understand, you are speaking about combobox and I can't see any combo

  8. #8
    Ok am sorry if I did not explain better if you look at the sample file I sent. I am using excel 2010 if you go to the developer tab on the ribbon, and then click on design mode one of the cells B2 to B8 or C2 to C8 will come alive with a box slightly larger than the normal cell, it will have a small arrow pointing down, if you then click on the box that has just been highlighted, then look in the name box just above column A you will see its called TempCombo and then across to the right just above column B or C you will see =EMBED("Forms.ComboBox.1","").

    As far as I know this is a combo box but I might be wrong as I have been wrong before

    I might be looking at this the wrong way what I need happen is the sample file to work like it is in the file I sent IE with a larger font and a longer list to pick from and not the default excel pick list with the small font and only 8 lines to choose from without scrolling down

    But I also want any comment box when clicked on display to the left and one row down if you can think of better way to achieve this please let me know

    Regards
    Last edited by sam2149; 2014-02-27 at 06:34 PM.

Posting Permissions

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