Delete rows based on value in different sheet

[clh_1496]

Hi,

How would I reference Sheet called Summary, cells G3 and J3 below so that it deletes rows with dates less the G3 and greater than J3? I can't seem to get it to look up the date in these cells to then delete rows from? And is it possible to delete cells based on time and date, for example, if cell U is before summary G3 AND cell V before summary G4?

lr = Cells(Rows.Count, "U").End(xlUp).Row 'find last row
For i = lr To 2 Step -1 'loop thru backwards, finish at 2 for headers
If Cells(i, "U").Value < "=Summary!G3" Then Rows(i).EntireRow.Delete
If Cells(i, "U").Value > "=Summary!J3" Then Rows(i).EntireRow.Delete
Next i

[#2]

@clh_1496 

Sub summary()

Dim lr As Integer
Dim i As Integer

lr = Cells(Rows.Count, "U").End(xlUp).Row 'find last row

For i = lr To 2 Step -1 'loop thru backwards, finish at 2 for headers

'column "U" is column21

If Cells(i, 21).Value < Worksheets("Summary").Cells(3, 7).Value Or Cells(i, 21).Value > Worksheets("Summary").Cells(3, 10).Value Then
Rows(i).EntireRow.Delete

Else

End If

Next i

End Sub

Maybe with these lines of code. In the attached file you can click the button in cell R1 to start the macro.

[#3]

@OliverScheurich 

Is it possible to add an AND so that it also looks at the date in col U and also the time in col V and if both are true then deletes the column? I tried to do it below and whilst it doesn't come up with an error, it doesn't seem to delete anything?

lr = Cells(Rows.Count, "U").End(xlUp).Row 'find last row
lr = Cells(Rows.Count, "V").End(xlUp).Row 'find last row
For i = lr To 2 Step -1 'loop thru backwards, finish at 2 for headers
'column "U" is column21
If Cells(i, 21).Value < Worksheets("Summary").Cells(3, 7).Value And Cells(i, 22).Value < Worksheets("Reference Sheet").Cells(12, 4).Value Or Cells(i, 21).Value > Worksheets("Reference Sheet").Cells(4, 4).Value And Cells(i, 22).Value > Worksheets("Reference Sheet").Cells(13, 4).Value Then
Rows(i).EntireRow.Delete

[#4]

@clh_1496 

Sub summaryandreference()

Dim lrU As Integer
Dim LrV As Integer
Dim i As Integer

lrU = Cells(Rows.Count, "U").End(xlUp).Row 'find last row
LrV = Cells(Rows.Count, "V").End(xlUp).Row 'find last row
For i = lrU To 2 Step -1 'loop thru backwards, finish at 2 for headers
'column "U" is column21
If Cells(i, 21).Value < Worksheets("Summary").Cells(3, 7).Value And _
Cells(i, 22).Value < Worksheets("Reference Sheet").Cells(12, 4).Value Or _
Cells(i, 21).Value > Worksheets("Summary").Cells(3, 10).Value And _
Cells(i, 22).Value > Worksheets("Reference Sheet").Cells(13, 4).Value Then
Rows(i).EntireRow.Delete
Else
End If
Next i


End Sub

Maybe with this code. You can click the button in cell P1 in the attached file to start the macro.

[#5]

@OliverScheurich 

Unfortunately still not working for me, not sure if it's because its part of a larger VBA whereby I'm excluding:

Dim lrU As Integer
Dim LrV As Integer
Dim i As Integer

My whole macro is below, and the row deleting part is at the very end as the last thing that gets done. Do I need to redim lr as integer etc to get this to work?

Sub DoAll()
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim tmpArray() As String
Dim Formulas() As Variant
'~~> This is the relevant sheet
Set ws = ThisWorkbook.Sheets("Clockings")
With ws
'Inserts Six Columns at C,D,E,F,G,H
.Range("C:H").EntireColumn.Insert
.Range("C1").Formula = "ID"
.Range("D1").Formula = "Description"
.Range("E1").Formula = "Shift"
.Range("F1").Formula = "Type"
.Range("G1").Formula = "MY"
.Range("H1").Formula = "B"
.Range("V:W").EntireColumn.Insert
.Range("Y:Z").EntireColumn.Insert
.Range("V1").Formula = "Start Date"
.Range("W1").Formula = "Start Time"
.Range("Y1").Formula = "End Date"
.Range("Z1").Formula = "End Time"
'Inserts specific formulae to cells V2 and W2
ReDim Formulas(1 To 2)
Formulas(1) = "=INT(U2)"
Formulas(2) = "=MOD(U2,1)"
.Range("V2:W2").Formula = Formulas
ReDim Formulas(1 To 2)
Formulas(1) = "=IF(X2="""","""",INT(X2))"
Formulas(2) = "=IF(X2="""","""",MOD(X2,1))"
.Range("Y2:Z2").Formula = Formulas
'Inserts specific formulae to cells C2,D2.E2.F2.G2 and H2
ReDim Formulas(1 To 6)
Formulas(1) = "=IFERROR(VLOOKUP(B2,'17 SO'!A:C,2,0),VLOOKUP(B2,'18 SO'!A:C,2,0))"
Formulas(2) = "=IFERROR(VLOOKUP(C2,'17 SO'!B:D,2,0),VLOOKUP(C2,'18 SO'!B:D,2,0))"
Formulas(3) = "=IF(AND(W2>='Reference Sheet'!$C$14,W2<='Reference Sheet'!$C$12),TEXT(V2-1,""ddd"")&"" ""&IF(AND(W2>='Reference Sheet'!$C$12,W2<'Reference Sheet'!$C$13),'Reference Sheet'!$D$12,'Reference Sheet'!$D$13),TEXT(V2,""ddd"")&"" ""&IF(AND(V2>='Reference Sheet'!$C$12,W2<'Reference Sheet'!$C$13),'Reference Sheet'!$D$12,'Reference Sheet'!$D$13))"
Formulas(4) = "=IF(ISNUMBER(SEARCH(""Sling"",D2)),""Sling/Lab"",IF(ISNUMBER(SEARCH(""Dress"",D2)),""NDT Dressing Support"",IF(ISNUMBER(SEARCH(""Downtime"",D2)),""Downtime"",IF(ISNUMBER(SEARCH(""jigs"",D2)),""Jigs"",IF(ISNUMBER(SEARCH(""NC"",C2)),""NCR"",IF(ISNUMBER(SEARCH(""M2"",C2)),""Change"",IF(ISNUMBER(SEARCH(""M3"",C2)),""Change"",""Earning"")))))))"
Formulas(5) = "=MID(C2,4,2)"
Formulas(6) = "=IF(ISNA(VLOOKUP(C2,'1811 SO'!B:B,1,FALSE)), ""III"", ""II"")"
.Range("C2:H2").Formula = Formulas
'Changes number format in Columns B and C to general
.Range("C:H").NumberFormat = "General"
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Range("C2:C" & LastRow).FillDown
.Range("D2:D" & LastRow).FillDown
.Range("E2:E" & LastRow).FillDown
.Range("F2:F" & LastRow).FillDown
.Range("G2:G" & LastRow).FillDown
.Range("H2:H" & LastRow).FillDown
.Range("V2:V" & LastRow).FillDown
.Range("W2:W" & LastRow).FillDown
.Range("Z2:Z" & LastRow).FillDown
.Range("Y2:y" & LastRow).FillDown
Columns("V:W").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Columns("Y:Z").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'delete column U
.Range("U:U").EntireColumn.Delete
.Range("W:W").EntireColumn.Delete
.Range("AI1").Formula = "Role"
.Range("AJ1").Formula = "Squad"
'Changes number format in Columns V to Time
.Range("V:V").NumberFormat = "hh:mm"
.Range("X:X").NumberFormat = "hh:mm"
.Range("U:U").NumberFormat = "dd/mm/yyyy"
.Range("W:W").NumberFormat = "dd/mm/yyyy"
'Inserts specific formulae to cells AI2 and AJ2
ReDim Formulas(1 To 2)
Formulas(1) = "=VLOOKUP(AG2,'Employee Info'!A:C,3,0)"
Formulas(2) = "=VLOOKUP(AH2,'Employee Info'!B:D,3,0)"
.Range("AI2:AJ2").Formula = Formulas
'Changes number format in Columns AI and AJ to general
.Range("AI:AJ").NumberFormat = "General"
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Range("AI2:AI" & LastRow).FillDown
.Range("AJ2:AJ" & LastRow).FillDown
lr = Cells(Rows.Count, "C").End(xlUp).Row 'find last row
For i = lr To 2 Step -1 'loop thru backwards, finish at 2 for headers
If Cells(i, "C").Text = "#N/A" Then Rows(i).EntireRow.Delete
Next i
lrU = Cells(Rows.Count, "U").End(xlUp).Row 'find last row
LrV = Cells(Rows.Count, "V").End(xlUp).Row 'find last row
For i = lrU To 2 Step -1 'loop thru backwards, finish at 2 for headers
'column "U" is column21
If Cells(i, 21).Value < Worksheets("Summary").Cells(3, 7).Value And _
Cells(i, 22).Value < Worksheets("Reference Sheet").Cells(12, 4).Value Or _
Cells(i, 21).Value > Worksheets("Summary").Cells(3, 10).Value And _
Cells(i, 22).Value > Worksheets("Reference Sheet").Cells(13, 4).Value Then
Rows(i).EntireRow.Delete
End If
Next i
End With
End Sub

[#6]

@clh_1496 

Unfortunately i can't help you with this. Maybe someone else can help you. You can as well start a new discussion with your question.