Cannot make worksheet change event to work

alexbat

New Member
Joined
Dec 12, 2013
Messages
32
Hi,

trying to un a macro when a specific cell is changed with the code below. Even though cell H5 changes (linked to cell in other sheet with formula =RR!E12)
my macro doesn't run. Any suggestions on what I might have done wrong?

/A

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False
    
    
    If Target.Address = "$H$5" Then
    
        With Sheets("Redovisnposter")
        
            .Range("A1:I20000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
            Range("Redovisnposter!Criteria"), CopyToRange:=Range("Redovisnposter!Extract" _
            ), Unique:=False
            
            .Range("V2", .Cells(.Rows.Count, "V").End(xlUp)).Copy
            
        End With
    
        With Sheets("Analys per konsult")
    
            .Range("B8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                      SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
            
            Set rData = .Range("B8", .Cells(.Rows.Count, "B").End(xlUp))
            rData.RemoveDuplicates Columns:=1, Header:=xlNo
    
                With .Sort
                    .SetRange rData
                    .Header = xlNo
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            
                With .Range("B8", .Cells(.Rows.Count, "B").End(xlUp)).Font
                    .Name = "Arial"
                    .Size = 8
                    .Strikethrough = False
                    .Superscript = False
                    .Subscript = False
                    .OutlineFont = False
                    .Shadow = False
                    .Underline = xlUnderlineStyleNone
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
                    .ThemeFont = xlThemeFontNone
                    
                End With
            
        End With
    End If
    Application.ScreenUpdating = True
End Sub
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
The Worksheet_Change event fires when the user makes a change on the worksheet. It won't fire if the result of a formula changes. You could try putting your code in the module for worksheet RR testing for a change in E12.
 
Upvote 0
If H5 contains a formula, it won't trigger the Change event when it recalculates - you'd need the Worksheet_Calculate event for that, or you could use a Change event on the sheet containing the cell that H5 links to.
 
Upvote 0
Changed tocode below, but then the bold part of the code is highlighted in the debuggr :

Code:
Private Sub Worksheet_Calculate()

    Application.ScreenUpdating = False
    
        [B]With Sheets("Redovisnposter")
        
            .Range("A1:I20000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
            Range("Redovisnposter!Criteria"), CopyToRange:=Range("Redovisnposter!Extract" _
            ), Unique:=False
        [/B]    
            .Range("V2", .Cells(.Rows.Count, "V").End(xlUp)).Copy
            
        End With
    
        With Sheets("Analys per konsult")
    
            .Range("B8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                      SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
            
            Set rData = .Range("B8", .Cells(.Rows.Count, "B").End(xlUp))
            rData.RemoveDuplicates Columns:=1, Header:=xlNo
    
                With .Sort
                    .SetRange rData
                    .Header = xlNo
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            
                With .Range("B8", .Cells(.Rows.Count, "B").End(xlUp)).Font
                    .Name = "Arial"
                    .Size = 8
                    .Strikethrough = False
                    .Superscript = False
                    .Subscript = False
                    .OutlineFont = False
                    .Shadow = False
                    .Underline = xlUnderlineStyleNone
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
                    .ThemeFont = xlThemeFontNone
                    
                End With
            
        End With

    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Changed the code to below, but then the bold part of the code is highlighted in the debugger:

Code:
Private Sub Worksheet_Calculate()

    Application.ScreenUpdating = False
    
        [B]With Sheets("Redovisnposter")                      .Range("A1:I20000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _             Range("Redovisnposter!Criteria"), CopyToRange:=Range("Redovisnposter!Extract" _             ), Unique:=False         [/B]    
            .Range("V2", .Cells(.Rows.Count, "V").End(xlUp)).Copy
            
        End With
    
        With Sheets("Analys per konsult")
    
            .Range("B8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                      SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
            
            Set rData = .Range("B8", .Cells(.Rows.Count, "B").End(xlUp))
            rData.RemoveDuplicates Columns:=1, Header:=xlNo
    
                With .Sort
                    .SetRange rData
                    .Header = xlNo
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            
                With .Range("B8", .Cells(.Rows.Count, "B").End(xlUp)).Font
                    .Name = "Arial"
                    .Size = 8
                    .Strikethrough = False
                    .Superscript = False
                    .Subscript = False
                    .OutlineFont = False
                    .Shadow = False
                    .Underline = xlUnderlineStyleNone
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
                    .ThemeFont = xlThemeFontNone
                    
                End With
            
        End With

    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Try:
Code:
Private Sub Worksheet_Calculate()

    Application.ScreenUpdating = False
    
        With Sheets("Redovisnposter")
                      .Range("A1:I20000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= .Range("Criteria"), _
CopyToRange:=.Range("Extract"), Unique:=False             
            .Range("V2", .Cells(.Rows.Count, "V").End(xlUp)).Copy
        End With
    
        With Sheets("Analys per konsult")
    
            .Range("B8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                      SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
            
            Set rData = .Range("B8", .Cells(.Rows.Count, "B").End(xlUp))
            rData.RemoveDuplicates Columns:=1, Header:=xlNo
    
                With .Sort
                    .SetRange rData
                    .Header = xlNo
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            
                With .Range("B8", .Cells(.Rows.Count, "B").End(xlUp)).Font
                    .Name = "Arial"
                    .Size = 8
                    .Strikethrough = False
                    .Superscript = False
                    .Subscript = False
                    .OutlineFont = False
                    .Shadow = False
                    .Underline = xlUnderlineStyleNone
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
                    .ThemeFont = xlThemeFontNone
                    
                End With
            
        End With

    Application.ScreenUpdating = True
End Sub

If that doesn't work, please say what the error is.
 
Upvote 0
Hi... i Have Two excel files
Input, Output

I have following sheet in file Output: Sheet1 and Sheet2

(code is pasted in the Output Excel File)


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If ActiveWorkbook.Sheets("Sheet2").Range("A1").Text = "" Then ActiveWorkbook.Sheets("Sheet2").Range("A1") = 3
    If Cells(Target.Row, 5) = "Target Achieved" Then
   
        Rows(Target.Row).Copy
        ActiveWorkbook.Sheets("Sheet2").Activate
        ActiveSheet.Rows(ActiveSheet.Range("A1").Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        ActiveSheet.Range("A1").Value = ActiveSheet.Range("A1").Value + 1
        ActiveWorkbook.Sheets("Sheet1").Activate
        Application.CutCopyMode = False
        
    End If
End Sub


Data is pulled in the Sheet1 of Output (from Input file)
using =[Input.xlsm]Sheet1!B1 etc



If column5 in sheet1 gets the value (from formula calculation) "Target Achieved" then
the entire row is copied to sheet2


but the worksheet_change is not triggered as data in output file is got from another excel file input file.


Kindly help me to solve the above.
 
Upvote 0
Dear Andrew Poulsom,
I am sorry to have flouted the rule by mistake.

the reason for me to post on this thread was my problem was on similar lines and hence a small tweak could help me.

I will do the needful.
Thanks and rgds.
Bhushan
 
Upvote 0

Forum statistics

Threads
1,215,335
Messages
6,124,327
Members
449,155
Latest member
ravioli44

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