Macros

Solved/Closed
Saky - Jun 11, 2010 at 07:10 AM
 Saky - Jun 14, 2010 at 06:21 AM
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

rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Jun 11, 2010 at 07:16 AM
See this one
It does pretty much what you seek
https://ccm.net/forum/affich-269392-dropdown-lists-in-excel-2007
0
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
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Jun 11, 2010 at 11:19 AM
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

0
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?
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Jun 11, 2010 at 12:23 PM
Same was was in that thread. But you dont have to create any list etc

Just paste the code as was instructed in that
0

Didn't find the answer you are looking for?

Ask a question
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?
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Jun 11, 2010 at 12:36 PM
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.
0
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
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Jun 11, 2010 at 12:53 PM
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
0
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
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Jun 11, 2010 at 01:09 PM
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
0
Moreover i am not getting any drop down list box in column E.
0
MS EXCEL 2003 and Windows XP
0
When i am opening the excel am not getting any dialogue box to enable the macro as well.
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Jun 11, 2010 at 01:21 PM
restart PC, some thing is wrong. the file that you gave me works. So what you did was right, Some thing else is up
0
Thanks Riz, I will try it on monday...Thanks for your support...Am leaving home..Happy weekend!!!!
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Jun 11, 2010 at 03:39 PM
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



0
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!!!
0