Hi All--
I have a Worksheet_Change event that occurs whenever a new value is added in column A of Sheet 1, it copies down formulas from the row above in columns B:AB and also creates a corresponding new row in Sheet 2. It works perfectly except when filtering is turned on.
The issue is that when data is filtered (column R), Sheet 1 events work as they should, but the new row is not added in Sheet 2.
I'd prefer not to have to deal with unfiltering and refiltering at all in the process, but I added an unfilter/refilter line to the macro as well, but it doesn't fix the problem (nor seem to actually affect the filtering at all). Relevant details regarding the filter follows below the code.
Worksheet code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, I As Long
Dim engLast As Long
Dim PMGLast As Long
Dim engLast2 As Long
Dim PMGLast2 As Long
On Error Resume Next
engLast = Sheets("Engineering").Range("A65536").End(xlUp).row
PMGLast = Sheets("PMG").Range("A65536").End(xlUp).row
Sheets("Engineering").Range("A1:S" & engLast).AutoFilter Field:=19, Criteria1:="="
Sheets("PMG").Range("A1:S" & PMGLast).AutoFilter Field:=18, Criteria1:="="
Set c = Intersect(Target, Columns(1))
If c = "" Then Exit Sub
If c Is Nothing Then Exit Sub
If IsEmpty(c.Offset(-1, 0)) Or Not IsEmpty(c.Offset(1, 0)) Then Exit Sub
Sheets("Engineering").Range("A1:S" & engLast).AutoFilter Field:=19, Criteria1:="="
Sheets("PMG").Range("A1:S" & PMGLast).AutoFilter Field:=18, Criteria1:="="
With c
.NumberFormat = "@"
End With
I = c.row
Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.Unprotect Password:=""
Target.Locked = False
Sheets("PMG").Unprotect Password:=""
Range("A" & I - 1).Copy
Range("A" & I).PasteSpecial Paste:=xlPasteFormats
Range("B" & I - 1 & ":AR" & I - 1).Copy Destination:=Range("B" & I & ":AR" & I)
With Range("F" & I & ":AR" & I)
.SpecialCells(xlCellTypeConstants).ClearContents
End With
Range("F" & I & ":I" & I).Formula = "*** RE ***"
Range("J" & I & ":N" & I).Formula = "*** DE ***"
Range("O" & I & ":R" & I).Formula = "*** VB ***"
Sheets("PMG").Range("A" & I - 1 & ":AS" & I - 1).Copy Destination:=Sheets("PMG").Range("A" & I & ":AS" & I)
With Sheets("PMG").Range("A" & I & ":AS" & I)
.SpecialCells(xlCellTypeConstants).ClearContents
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
Target.Locked = False
engLast2 = Sheets("Engineering").Range("A65536").End(xlUp).row
PMGLast2 = Sheets("PMG").Range("A65536").End(xlUp).row
Sheets("Engineering").Range("A1:S" & engLast2).AutoFilter Field:=19
Sheets("PMG").Range("A1:S" & PMGLast2).AutoFilter Field:=18
Sheets("PMG").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
Application.EnableEvents = True
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
Facts about the filter: - Only the spreadsheet owner uses filtering to display rows that have blanks in column R (with a toggle button I created so that Sheets 1 & 2 are filtered the same).
- Newly added rows will have a blank in column R by default, so it would be visible with or without filtering turned on.
- The department that enters the new column A data does not have permission to use the filter (nor would they remember to do so).
Any ideas or suggestions would be greatly appreciated.
Bookmarks