Forum Discussion

clh_1496's avatar
clh_1496
Brass Contributor
Jun 07, 2022

Delete rows based on value in different sheet

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...
excel
Formulas and Functions
Macros and VBA
OliverScheurich's avatar
OliverScheurich
Gold Contributor
Jun 07, 2022

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.

  • clh_1496's avatar
    clh_1496
    Brass Contributor
    Jun 08, 2022

    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

    • OliverScheurich's avatar
      OliverScheurich
      Gold Contributor
      Jun 08, 2022

      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.

      • clh_1496's avatar
        clh_1496
        Brass Contributor
        Jun 14, 2022

        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

Resources