Help Slight Adjustment to code For Running Macro on In Cell Drop Down Value

USFengBULLS

Board Regular
Joined
May 7, 2018
Messages
66
Office Version
  1. 365
Platform
  1. Windows
Hello All,

I have a code that runs perfectly that calls up two other macros (APPROVED, REJECTED) that work perfectly as well. Its based off a change to the Cell I11 where I have that cell as a in cell drop down list that the User can select either APPROVED or REJECTED and these two macros run fine. The problem is that every cell from I11:I500 is this Excel drop down list and I need this code to Run for all the in cell drop downs from I11:I500

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I11")) Is Nothing Then
Select Case Range("I11")
Case "APPROVED": APPROVED
Case "REJECTED": REJECTED
End Select
End If
End Sub

If I substitute I11 with I11:I500 in the above code it of course doesn't work but logically that's what I need it to do.
Can anyone please help me with this?
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Try:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("I11:I500")) Is Nothing Then
        Select Case Target.Value
            Case "APPROVED": APPROVED
            Case "REJECTED": REJECTED
        End Select
    End If
End Sub
 
Upvote 0
Hi,
In order to help you out there's further clarification needed from you how you want the code work
You have dropdown list in range i11:i500 so, when you change value in on of the cell within the range you want to:
1. Run one of the macros based on valeue only within the cell the change is being made or...
2. Run one of the macros based on the values in all the cells within the range no matter in which cell whithin the range the value change is being made

Regards,
Sebastian
 
Upvote 0
Mumps..I tried and didn't work.

Mentor82,
1. is what I need. Run the macro based on the value only in the cell that changed. So the drop in cell drop down goes from I11:1500. Lets say I want to go to the status of that item in cell I22 and change it to "APPROVED" I want it to run that Macro...which is working fine. The two macro I tied to that in cell drom drop List work fine. the issuer is that it only works when I choose them in I11 because of the Worksheet event code I posted above. I need that target range to be for all of I11:I500...not just for I11.
 
Upvote 0
I tried it on a dummy file and it worked properly. The problem with your code was that this line:
Code:
Select Case Range("I11")
looks only at cell I11. The code I posted, looks at the target value so if change cell I22 to "APPROVED", I22 is your target cell and the macro will be triggered as soon as you select "APPROVED". If it still doesn't work then I think that it would be easier to help and test possible solutions if I could work with your actual file which includes any macros you are currently using. Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
 
Upvote 0
Actually you're it is working. I think I am getting errors due to my other 2 macros it runs.. Can you glance over these and see what the issue may be?
Public Sub APPROVED()
Dim LastRow As Integer, i As Integer, erow As Integer
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row


For i = 11 To LastRow
If Cells(i, 9).Value = "APPROVED" Then
Range(Cells(i, 1), Cells(i, 3)).Select
Selection.Copy
Sheets("FINISH SCHEDULE").Select
erow = Sheets("FINISH SCHEDULE").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheets("FINISH SCHEDULE").Cells(erow, 1).Select
Sheets("FINISH SCHEDULE").Paste
End If
Next i


End Sub



Public Sub REJECTED()


With Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 9))
.Offset(1).Insert shift:=xlDown
Application.CutCopyMode = False
End With


End Sub


Here's the link to DropBox Folder
https://www.dropbox.com/sh/dunqarfm89unhbu/AABMkvpgW6HYXBrOry2qpXPTa?dl=0
 
Last edited:
Upvote 0
It could work like this, in your sheet:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("I:I")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        Select Case Target.Value
            Case "APPROVED": Call APPROVED(Target.Row)
            Case "REJECTED": Call REJECTED(Target.Row)
        End Select
    End If
End Sub



In your module:

Code:
Public Sub APPROVED(tRow As Double)
    Dim erow As Double
    erow = Sheets("FINISH SCHEDULE").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    Range(Cells(tRow, 1), Cells(tRow, 3)).Copy Sheets("FINISH SCHEDULE").Cells(erow, 1)
End Sub
'
Public Sub REJECTED(tRow As Double)
    Range(Cells(tRow, 1), Cells(tRow, 9)).Offset(1).Insert shift:=xlDown
End Sub
 
Upvote 0
DanteAmor...This works absolutely PERFECTLY.
Thank you so much!
 
Upvote 0
This macro incorporates all you code in one macro so that you don't need the other two macros.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("I11:I500")) Is Nothing Then Exit Sub
    Dim i As Long, LastRow As Long
    LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    Select Case Target.Value
        Case "APPROVED"
            For i = 11 To LastRow
                If Cells(i, 9).Value = "APPROVED" Then
                     Cells(i, 1).Resize(1, 3).Copy Sheets("FINISH SCHEDULE").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                End If
            Next i
        Case "REJECTED"
            Cells(Target.Row, 1).Resize(1, 9).Offset(1).Insert shift:=xlDown
    End Select
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,983
Messages
6,122,598
Members
449,089
Latest member
Motoracer88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top