Macro for running a macro when any cell in a range of cells changes

Hello Experts,

Greetings. I am thankfull for all the supports you provide. As usual, I need your support to generate a macro.

I have Sheet1, in which Cells D14 to C20 are the targets. If any of these cells changes, I want to run the following macro.

Sub Button11_Click()
'
' Button11_Click Macro
' Macro recorded 12-25-2013 by gmk
'
' Keyboard Shortcut: Ctrl+f
'
    ActiveWindow.SmallScroll Down:=-9
    Range("C14:D20").Select
    Selection.Copy
    Range("C31").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("D31"), Order1:=xlDescending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End Sub

Can you please help me. My sincere thanks for all experts.

Should I paste your program in the Module / Worksheet or in the Workbook?

Regards,
gm2612

Sub Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Range("C14:D20"), Target) Is Nothing Then
    Range("C14:D20").Select
    Selection.Copy
    Range("C31").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("D31"), Order1:=xlDescending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
  end if
End Sub

paste the code in the Worksheet module

Hi, gm2612,

maybe drop the first Sub from what patel45 wrote?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("C14:D20"), Target) Is Nothing Then
  Application.EnableEvents = False
  With Range("C31:D37")
    .Value = Range("C14:D20").Value
    .Sort Key1:=Range("D31"), _
        Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
  End With
  Application.EnableEvents = True
End If
End Sub

Ciao,
Holger

Hi, gm2612,

as long as we don´t see your workbook I think it´s hard to get the reason for the error you mention. There may only be one Event of that name behind each sheet.

Please check the attachment if it´s doing what you want it to do - if the changes are to be made via Formulas you should indicate this as I assumed this change to be via Entry/Edit directly into the target area. And the code will only work if one single cell inside the yellow area is altered.

Ciao,
Holger

Hello Holger,

pardon me for not sending the workbook. I have attached it now. There are two sheets named OTD and Trend. I have given the information in the respective sheets. Can you please help me out?

Thanks and regards,
G.Manikandan

Sample sheet for solving.xls

Hi, gm2612,

you should add the logic of the worksheets as you want - there are formulas missing and the logic of percentages should be amended.

Code goes behind worksheet OTD and will get triggered when any cell in the used range in Column E will be changed:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("E4:E" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
  With Sheets("Trend")
    .Range("C31:D37").Value = .Range("C14:D20").Value
    .Range("C14:D20").Sort Key1:=.Range("D31"), _
        Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
  End With
End If
End Sub

Ciao,
Holger

Hi, gm2612,

regarding the sorting: my bad, I just took the wrong area.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("G7:G" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
  With Sheets("Sheet1")
    .Range("C30:D36").Value = .Range("C14:D20").Value
    .Range("C30:E36").Sort Key1:=.Range("D30"), _
        Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
  End With
End If
End Sub

Again: your should check your formulas and sections, they might not meet with your requirements.

Ciao,
Holger