FeatherM
11-02-2020, 12:59 AM
Hi,
I am using a code to based on a list of values I create several new Sheets. Then Filter is applied to Filter only the Rows which contain the same Value from the List.
After that I want to delete all non-used Rows in Filter.
This code works perfectly fine on the first created sheet, but it is not working on the next new sheets, Why so?
My code:
wsMRD1.Select
Dim cList As Range
Dim LastrowTemp As Integer
LastrowTemp = wsMRD1.Cells(Rows.Count, "J").End(xlUp).Row
Dim LastCunique As Integer
LastCunique = wsC.Cells(Rows.Count, "A").End(xlUp).Row
For Each cList In wsC.Range("A35:A" & LastCunique)
wsMRD1.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = cList.Value: ActiveSheet.Range("H1") = cList.Value: ActiveSheet.Range("$A$4:J" & LastrowTemp).AutoFilter Field:=10, Criteria1:="=Cd.", _
Operator:=xlOr, Criteria2:=Range("=H1").Value: Range("J5:J" & LastrowTemp).Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
With ActiveSheet.Name = cList.Value
Dim oRow As Range, rngD As Range
Dim myRows As Range
Set myRows = Intersect(ActiveSheet.Range("A:A").EntireRow, ActiveSheet.UsedRange)
If myRows Is Nothing Then Exit Sub
For Each oRow In myRows.Columns(1).Cells
If oRow.EntireRow.Hidden Then
If rngD Is Nothing Then
Set rngD = oRow
Else
Set rngD = Union(rngD, oRow)
End If
End If
Next
If Not rngD Is Nothing Then rngD.EntireRow.Delete 'NOT WORKING ON NEXT SHEETS (cList), WHY? Filter works, but Rows are not deleted.
I am using a code to based on a list of values I create several new Sheets. Then Filter is applied to Filter only the Rows which contain the same Value from the List.
After that I want to delete all non-used Rows in Filter.
This code works perfectly fine on the first created sheet, but it is not working on the next new sheets, Why so?
My code:
wsMRD1.Select
Dim cList As Range
Dim LastrowTemp As Integer
LastrowTemp = wsMRD1.Cells(Rows.Count, "J").End(xlUp).Row
Dim LastCunique As Integer
LastCunique = wsC.Cells(Rows.Count, "A").End(xlUp).Row
For Each cList In wsC.Range("A35:A" & LastCunique)
wsMRD1.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = cList.Value: ActiveSheet.Range("H1") = cList.Value: ActiveSheet.Range("$A$4:J" & LastrowTemp).AutoFilter Field:=10, Criteria1:="=Cd.", _
Operator:=xlOr, Criteria2:=Range("=H1").Value: Range("J5:J" & LastrowTemp).Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
With ActiveSheet.Name = cList.Value
Dim oRow As Range, rngD As Range
Dim myRows As Range
Set myRows = Intersect(ActiveSheet.Range("A:A").EntireRow, ActiveSheet.UsedRange)
If myRows Is Nothing Then Exit Sub
For Each oRow In myRows.Columns(1).Cells
If oRow.EntireRow.Hidden Then
If rngD Is Nothing Then
Set rngD = oRow
Else
Set rngD = Union(rngD, oRow)
End If
End If
Next
If Not rngD Is Nothing Then rngD.EntireRow.Delete 'NOT WORKING ON NEXT SHEETS (cList), WHY? Filter works, but Rows are not deleted.