Macros [Solved/Closed]

Report
-
 Saky -
Hi,

I need a macro coding for the below scenario.

In column D(Application) i have created a validation in which i have included the list of applications. So what i need is, if i select the first application from the list say "ACBS" then in the next column E (ACTIVITY) the list which i have entered in Column N should get populated in a drop down list box.

If i select the second application Adhoc then in the column E the list which i have entered in Column O should get populated in a drop down list box. and it goes on like that till Application UBIX - Column AP.

Please assist. I have attached the excel for your reference.


https://authentification.site/files/22905960/Copy_of_MIS.xls

12 replies

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
762
See this one
It does pretty much what you seek
https://ccm.net/forum/affich-269392-dropdown-lists-in-excel-2007
Riz,

I tried as per your instruction and i got the result which i have attached.

I dont think it works for me. It would be great if you could provide me a solution for the excel which i have attached earlier.

Thanks in advance!

https://authentification.site/files/22907054/proj.xls
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
762
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim mainSrc As String
Dim iMainSrcCol As Integer
Dim subSrc As String
Dim iSubSrcCol As Long

Dim lThisRow As Long
Dim Cell As Range
Dim lMinTargetRow As Long

Dim sValidationSrcSheet As String
Dim rngValidationSrcCell As Range
Dim iValidationSrcCol As Integer
Dim lValidationSrcRow As Long
Dim sValidationSrcAdd As String

    iMainSrcCol = 4
    iSubSrcCol = 5
    lMinTargetRow = 4
    sValidationSrcSheet = ActiveSheet.Name
    
    On Error GoTo Error_Handler
    
    Application.EnableEvents = False
    
    For Each Cell In Target
      
        If Cell.Column <> iMainSrcCol Then GoTo Next_Cell
        If Cell.Row < lMinTargetRow Then GoTo Next_Cell
          
        mainSrc = Cell
        lThisRow = Cell.Row
        
        If mainSrc = "" Then
            Cells(lThisRow, iSubSrcCol).Validation.Delete
            Cells(lThisRow, iSubSrcCol) = ""
            GoTo Next_Cell
        End If

        
        On Error Resume Next
            subSrc = Cells(lThisRow, iSubSrcCol).Validation.Formula1
        On Error GoTo 0
        
        If ("=" & subSrc = mainSrc) Then
            GoTo Next_Cell
        End If
        
        Set rngValidationSrcCell = Sheets(sValidationSrcSheet).Cells.Find(mainSrc, Cells(1, 1), SearchDirection:=xlNext, SearchOrder:=xlByRows)
        
        If (rngValidationSrcCell Is Nothing) Then GoTo Next_Cell
        
        iValidationSrcCol = rngValidationSrcCell.Column
        lValidationSrcRow = Cells(Rows.Count, iValidationSrcCol).End(xlUp).Row
        
        sValidationSrcAdd = Range(Cells(rngValidationSrcCell.Row + 1, iValidationSrcCol), Cells(lValidationSrcRow, iValidationSrcCol)).Address
        
        Cells(lThisRow, iSubSrcCol) = ""
        With Cells(lThisRow, iSubSrcCol).Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="='" & sValidationSrcSheet & "'!" & sValidationSrcAdd
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = "This is my Input Title"
            .ErrorTitle = "Oops Error"
            .InputMessage = "Select a Value"
            .ErrorMessage = "Not a valid value"
            .ShowInput = True
            .ShowError = True
        End With
    
Next_Cell:

    Next Cell
    
End_Sub:
    
    Application.EnableEvents = True
    Set Cell = Nothing
    Exit Sub

Error_Handler:
    MsgBox Err.Description
    GoTo End_Sub
    
End Sub

Riz,

Thanks for the code. Please guide me how to use the code? what are the steps i have to do before pasting the code?
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
762
Same was was in that thread. But you dont have to create any list etc

Just paste the code as was instructed in that
But you have given me the macro with change event(Private Sub Worksheet_Change(ByVal Target As Range)

But i am using only one sheet. Then how come the macro will work without changing the worksheet?
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
762
Step1
1. Open the file
2. PRESS ALT + F11 to start VBE
3. PRESS CTRL + R to launch project explorer
4. Double Click on the sheet where the drop downs would be
5. Paste the code

Test.
No it doesn't work:( I have attached my excel..Please check and correct me where i am going wrong??

Riz, I need your help to sort this out...Kindly bare with me and help me..

https://authentification.site/files/22910659/Copy_of_MIS.xls
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
762
It is fine and working. How are you using it ?

When you open it, you would get a dialog to enable the macro, ENABLE then

It you change a value in column D4, you will see that in E4 the drop down changes
when i change value in D4 it throws out a error in the line

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="='" & sValidationSrcSheet & "'!" & sValidationSrcAdd.

Kindly advice..pl
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
762
Are you using same workbook that you uploaded here
https://authentification.site/files/22910659/Copy_of_MIS.xls

Plus what version of office and os you are using
Moreover i am not getting any drop down list box in column E.
MS EXCEL 2003 and Windows XP
When i am opening the excel am not getting any dialogue box to enable the macro as well.
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
762
restart PC, some thing is wrong. the file that you gave me works. So what you did was right, Some thing else is up
Thanks Riz, I will try it on monday...Thanks for your support...Am leaving home..Happy weekend!!!!
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
762
Ok, I had issue on office xp on win XP.

Try this. It works on XP-XP,. should work up too

Private Sub Worksheet_Change(ByVal Target As Range)
Dim mainSrc As String
Dim iMainSrcCol As Integer
Dim subSrc As String
Dim iSubSrcCol As Long

Dim lThisRow As Long
Dim Cell As Range
Dim lMinTargetRow As Long

Dim sValidationSrcSheet As String
Dim rngValidationSrcCell As Range
Dim iValidationSrcCol As Integer
Dim lValidationSrcRow As Long
Dim sValidationSrcAdd As String
Dim sValidatationStartAddress As String
Dim sValidatationEndAddress As String

    iMainSrcCol = 4
    iSubSrcCol = 5
    lMinTargetRow = 4
    
    sValidatationStartAddress = "$N$3"
    sValidatationEndAddress = "$AP$3"
    
    sValidationSrcSheet = ActiveSheet.Name
    
    On Error GoTo Error_Handler
    
    Application.EnableEvents = False
    
    For Each Cell In Target
      
        If Cell.Column <> iMainSrcCol Then GoTo Next_Cell
        If Cell.Row < lMinTargetRow Then GoTo Next_Cell
          
        mainSrc = Cell
        lThisRow = Cell.Row
        
        If mainSrc = "" Then
            Cells(lThisRow, iSubSrcCol).Validation.Delete
            Cells(lThisRow, iSubSrcCol) = ""
            GoTo Next_Cell
        End If

        
        On Error Resume Next
            subSrc = Cells(lThisRow, iSubSrcCol).Validation.Formula1
        'On Error GoTo Error_Handler
        On Error GoTo 0
        If ("=" & subSrc = mainSrc) Then
            GoTo Next_Cell
        End If
        
        Set rngValidationSrcCell = Sheets(sValidationSrcSheet).Range(sValidatationStartAddress & ":" & sValidatationEndAddress).Find(mainSrc, Range(sValidatationStartAddress), LookAt:=xlWhole, SearchDirection:=xlNext, SearchOrder:=xlByRows)
        
        If (rngValidationSrcCell Is Nothing) Then GoTo Next_Cell
        
        iValidationSrcCol = rngValidationSrcCell.Column
        lValidationSrcRow = Cells(Rows.Count, iValidationSrcCol).End(xlUp).Row
        
        sValidationSrcAdd = Range(Cells(rngValidationSrcCell.Row + 1, iValidationSrcCol), Cells(lValidationSrcRow, iValidationSrcCol)).Address
        
        Cells(lThisRow, iSubSrcCol) = ""
        With Cells(lThisRow, iSubSrcCol).Validation
            .Delete
           '.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="='" & sValidationSrcSheet & "'!" & sValidationSrcAdd
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & sValidationSrcAdd
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = "This is my Input Title"
            .ErrorTitle = "Oops Error"
            .InputMessage = "Select a Value"
            .ErrorMessage = "Not a valid value"
            .ShowInput = True
            .ShowError = True
        End With
    
Next_Cell:

    Next Cell
    
End_Sub:
    
    Application.EnableEvents = True
    Set Cell = Nothing
    Exit Sub

Error_Handler:
    MsgBox Err.Description
    GoTo End_Sub
    
End Sub



Riz,

Thanks a million....This code works very perfectly...Riz u r my saviour...U really helped me a lot...Thanks a ton dude..

You are a star!!!

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!