Macro does not delete all the required rows

[forest8]

Hi

I start with a single worksheet in an excel file. My macro copies this
worksheet six times and renames each spreadsheet: Monday, Tuesday, Wednesday,
Thursday, Friday, Saturday, and Sunday.

Then macro then returns to the first spreadsheet and deletes all rows within
a range so that it only includes the data for Monday.

Then it moves to "Tuesday" and is supposed to delete all rows in a range
except Tuesday but it doesn't work properly. It deletes everything but
Tuesday and Wednesday.

This is the same for all spreadsheets until Sunday. "Sunday" retains only
Sunday data and is what I'm looking for.

How do I fix my macro?

My macro reads the following for "Tuesday" and "Wednesday". This should give
you an idea of what I'm doing. Thanks in advance for any help in this.

' TUESDAY
Sheets("Tuesday").Select
Row = 6

' KEEPS ROWS WITH TUESDAY AS THE DAY OF THE WEEK
Do While Cells(Row, 4).Value = "Monday"
Row = Row + 1
Loop
BeginningRow = 5
Lastrow = Row
RowRange = BeginningRow & ":" & (Lastrow - 1)
Rows(RowRange).Delete


Do Until Cells(Row, 4).Value <> "Tuesday"
Row = Row + 1
Loop
BeginningRow = Row
Lastrow = ActiveSheet.UsedRange.Rows.Count + 1
RowRange = BeginningRow & ":" & Lastrow
Rows(RowRange).Delete


Range("A1").Select
With Selection
.HorizontalAlignment = xlLeft
.Font.Size = 11
.Font.Bold = True
.Value = "The Average Minute Audience (AMA) for CBC Newsworld Programs"
End With
Range("A2").Select
With Selection
.HorizontalAlignment = xlLeft
.Font.Size = 9
.Font.Bold = True
.Value = WeekNumber & ":" & " " & DayofWeek & "," & " " & ReportMonth &
" " & ReportDay & "," & " " & ReportYear
End With

' PUTS A BORDER ON THE BOTTOM OF THE LAST ROW
Lastrow = ActiveSheet.UsedRange.Rows.Count
BorderRange = "A" & Lastrow & ":" & " " & "N" & Lastrow
Range(BorderRange).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("A1").Select

Selection.Cut Destination:=Range("C1")
Range("C2").Select
Selection.EntireRow.Insert
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Range("A6").Select
Selection.EntireRow.Delete
Selection.EntireRow.Delete

' WEDNESDAY
Sheets("Wednesday").Select
Row = 6

' KEEPS ROWS WITH WEDNESDAY AS THE DAY OF THE WEEK
Do While Cells(Row, 4).Value = "Monday" Or Cells(Row, 4).Value = "Tuesday"
Row = Row + 1
Loop
BeginningRow = 5
Lastrow = Row
RowRange = BeginningRow & ":" & (Lastrow - 1)
Rows(RowRange).Delete



Do Until Cells(Row, 4).Value <> "Wednesday"
Row = Row + 1
Loop
BeginningRow = Row
Lastrow = ActiveSheet.UsedRange.Rows.Count + 1
RowRange = BeginningRow & ":" & Lastrow
Rows(RowRange).Delete


Range("A1").Select
With Selection
.HorizontalAlignment = xlLeft
.Font.Size = 11
.Font.Bold = True
.Value = "The Average Minute Audience (AMA) for CBC Newsworld Programs"
End With
Range("A2").Select
With Selection
.HorizontalAlignment = xlLeft
.Font.Size = 9
.Font.Bold = True
.Value = WeekNumber & ":" & " " & DayofWeek & "," & " " & ReportMonth &
" " & ReportDay & "," & " " & ReportYear
End With

' PUTS A BORDER ON THE BOTTOM OF THE LAST ROW
Lastrow = ActiveSheet.UsedRange.Rows.Count
BorderRange = "A" & Lastrow & ":" & " " & "N" & Lastrow
Range(BorderRange).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("A1").Select

 

[OssieMac]

I haven’t totally analysed your code but you need to work backwards when
writing code to delete rows.

Take the following For Next

For i = 1 to 100
If row(i) meets a specific condition then delete
Next i

Now say i is 4 and therefore row 4 is tested and if it meets the condition
then it gets deleted. Row 5 takes its place and becomes new row 4 but the
next iteration of i is 5 so the next row to be tested is row 5 and therefore
the new row 4 is not tested.

The following sub deletes all rows where the cell is not equal to Tuesday.
A couple of things to note.
A space and underscore at the end of a line is a line break in an otherwise
single line of code.
When you assign a range to a variable like Set rngToTest = .......
When addressing the cells in the assigned range using cells(), the cells in
the range are like a mini worksheet within the sheet and the cells within the
assigned range start at row1,column1

Sub DeleteRows()
Dim rngToTest As Range
Dim columnId As String
Dim rowStart As Long
Dim i As Long

'Edit K in following line to match the column with Day of week
columnId = "K"

'Edit 2 in the following line to match the first row of data
rowStart = 2

'Edit Sheet name to match your sheet name
With Sheets("Tuesday")
Set rngToTest = Range(.Cells(rowStart, columnId), _
.Cells(.Rows.Count, columnId).End(xlUp))
End With

With rngToTest
'Must work backwards from bottom when deleting rows
For i = .Rows.Count To 1 Step -1
If .Cells(i, 1) <> "Tuesday" Then
.Cells(i, 1).EntireRow.Delete
End If
Next i
End With

End Sub

 

[OssieMac]

Just a little extra for you. You can iterate through your worksheets with the
following code to delete all rows where the cells in the test range do not
match the worksheet name. The case statement is in case you have other
worksheets in the workbook that you do not need to test and using Case in
lieu of If statements is a lot easier to edit to include the required sheets.

Sub WSIteration()

Dim ws As Worksheet
Dim strWsname As String
Dim rngToTest As Range
Dim columnId As String
Dim rowStart As Long
Dim i As Long

'Edit K in following line to match the column with Day of week
columnId = "K"

'Edit 2 in the following line to match the first row of data
rowStart = 2

For Each ws In Worksheets
strWsname = ws.Name
MsgBox strWsname
Select Case strWsname
Case "Monday", "Tuesday", "Wednesday", "Thursday", _
"Friday", "Saturday", "Sunday"
With ws
Set rngToTest = Range(.Cells(rowStart, columnId), _
.Cells(.Rows.Count, columnId).End(xlUp))
End With

With rngToTest
'Must work backwards from bottom when deleting rows
For i = .Rows.Count To 1 Step -1
If .Cells(i, 1) <> strWsname Then
.Cells(i, 1).EntireRow.Delete
End If
Next i
End With

End Select
Next ws

Set rngToTest = Nothing

End Sub

 

[Don Guillett]

Lots of better ways to do what is desired with a loop, etc. However, have
you tried just using
data>filter>autofilter>filter on the day desired and work with it withOUT
copying to another sheet at all.