Results 1 to 14 of 14
  1. #1
    2 Star Lounger
    Join Date
    Oct 2001
    Location
    Not in KC anymore
    Posts
    192
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Automatically delete cells/rows (97)

    Automatically delete cells/rows

    Is there a way to automatically delete a row or cell based on some sort of if/then statement?

    For example, the spreadsheet has 400 rows of data with the needed data (time and date specific) scattered throughout. I need to filter out just certain criteria.

    Currently I use the filter to filter and remove what I don't need, but I'd like a way to automate it.

    It's pulled from a web-based query, so there's no way to modify the query.

    Thanks!

  2. #2
    Uranium Lounger
    Join Date
    Dec 2000
    Location
    Salt Lake City, Utah, USA
    Posts
    9,508
    Thanks
    0
    Thanked 6 Times in 6 Posts

    Re: Automatically delete cells/rows (97)

    What is the criteria for deletion, and what column(s) does the criteria usually reside in?
    -John ... I float in liquid gardens
    UTC -7ąDS

  3. #3
    2 Star Lounger
    Join Date
    Oct 2001
    Location
    Not in KC anymore
    Posts
    192
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Automatically delete cells/rows (97)

    The criteria is a date. Everything but the current day's.

    It resides in column D.

    Didn't know if it could be based on the function Today() or not.

    I can figure out how to find it if I know how to get the row to delete. That's what I can't figure.

    Thanks!

  4. #4
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Automatically delete cells/rows (97)

    The VBA procedure below will delete all of the rows of data on Sheet1 that do not contain todays date in column D.

    <pre>Public Sub DelNotToday()
    Dim I As Long, lLastRow As Long
    Dim datRow As Date, datToday As Date
    lLastRow = Worksheets("Sheet1").Range("D65536").End(xlUp).Row - 1
    datToday = Date
    For I = lLastRow To 0 Step -1
    With Worksheets("Sheet1").Range("D1")
    datRow = DateSerial(Year(.Offset(I, 0).Value), Month(.Offset(I, 0).Value), Day(.Offset(I, 0).Value))
    If datRow <> datToday Then
    .Offset(I, 0).EntireRow.Delete
    End If
    End With
    Next I
    End Sub
    </pre>

    Legare Coleman

  5. #5
    Star Lounger
    Join Date
    Aug 2001
    Location
    Bloomington, Indiana, USA
    Posts
    75
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Automatically move rows/cells (was delete row)

    I have a similar situation that I am trying to work out. I have a worksheet with hundreds of rows of data. One column is an end date column. (column K) What I want to do is automate the process of determining if the end date has passed, and then move that row to another worksheet in the same workbook called "terminated". I want to append the row below the existing rows in the terminated sheet. So far I have been doing this manually with copy, paste, and delete, and have set up conditional formatting to make the end dates change color when the date is reached.

    I have not used VBA before other than to copy and paste what someone else has written and told me where to put it.

    Thanks for any help
    Greg <img src=/S/dizzy.gif border=0 alt=dizzy width=15 height=15>

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Automatically move rows/cells (was delete row)

    Here is a variation on Legare Coleman's code. It assumes that the source worksheet is named Current and the target worksheet is named Terminated. It also assumes that row 1 is filled with field names.

    Public Sub MoveToTerminated()
    Dim I As Long, lLastRow As Long, lLastPasteRow As Long
    Dim datRow As Date, datToday As Date
    Dim rng As Range
    lLastRow = Worksheets("Current").Range("K65536").End(xlUp).Ro w - 1
    lLastPasteRow = Worksheets("Terminated").Range("K65536").End(xlUp) .Row
    datToday = Date
    For I = lLastRow To 1 Step -1
    With Worksheets("Current").Range("K1")
    Set rng = .Offset(I, 0)
    datRow = DateValue(rng.Value)
    If datRow < datToday Then
    rng.EntireRow.Copy _
    Worksheets("Terminated").Range("A1").Offset(lLastP asteRow, 0)
    rng.EntireRow.Delete
    lLastPasteRow = lLastPasteRow + 1
    End If
    End With
    Next I
    End Sub

    Explanation for some of the statements:

    <font color=blue>lLastRow = Worksheets("Current").Range("K65536").End(xlUp).Ro w - 1</font color=blue>
    determines the row number last populated cell in column K in the Current sheet and subtracts 1 because we're going to use it as offset.
    <font color=blue>lLastPasteRow = Worksheets("Terminated").Range("K65536").End(xlUp) .Row</font color=blue>
    Does the same for the Terminated sheet, but doesn't subtract 1 because we're going to paste below the current range.
    <font color=blue>For I = lLastRow To 1 Step -1</font color=blue>
    Step backwards through the table. This is necessary because the deleted rows cause the rows below to move up. If we stepped downwards, we would miss rows that had moved up.
    <font color=blue>Set rng = .Offset(I, 0)</font color=blue>
    This is the cell I rows below K1.
    <font color=blue>datRow = DateValue(rng.Value)</font color=blue>
    Convert value of cell to date.
    <font color=blue>rng.EntireRow.Copy _
    Worksheets("Terminated").Range("A1").Offset(lLastP asteRow, 0)</font color=blue>
    If date in cell is before current date, copy to first empty row in Terminated sheet.
    <font color=blue>rng.EntireRow.Delete</font color=blue>
    Delete row from Current sheet.
    <font color=blue>lLastPasteRow = lLastPasteRow + 1</font color=blue>
    Next row in Terminated sheet.

  7. #7
    Star Lounger
    Join Date
    Aug 2001
    Location
    Bloomington, Indiana, USA
    Posts
    75
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Automatically move rows/cells (was delete row)

    Thanks for the help, but I am a VBA Idiot. Where do I put this, and how do I activate/use it?

    Also the field names are in row 4.Rows 1-3 are other header information and calculations. I'm not sure where to change the code to reflect this.

    Thanks again
    Greg <img src=/S/dizzy.gif border=0 alt=dizzy width=15 height=15>

  8. #8
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Automatically move rows/cells (was delete row)

    The code below is Hans' code modified to ignore the first four rows.

    <pre>Public Sub MoveToTerminated()
    Dim I As Long, lLastRow As Long, lLastPasteRow As Long
    Dim datRow As Date, datToday As Date
    Dim rng As Range
    lLastRow = Worksheets("Current").Range("K65536").End(xlUp).Ro w - 1
    lLastPasteRow = Worksheets("Terminated").Range("K65536").End(xlUp) .Row
    datToday = Date
    For I = lLastRow To 4 Step -1
    With Worksheets("Current").Range("K1")
    Set rng = .Offset(I, 0)
    datRow = DateValue(rng.Value)
    If datRow < datToday Then
    rng.EntireRow.Copy _
    Worksheets("Terminated").Range("A1").Offset(lLastP asteRow, 0)
    rng.EntireRow.Delete
    lLastPasteRow = lLastPasteRow + 1
    End If
    End With
    Next I
    End Sub
    </pre>


    If you are only going to use this code in one workbook, then the best place to put it is in a module in that workbook. Here is how to do that:

    1- Copy the code from above in this message.

    2- This step is necessary sometimes. Open Windows Notebook and paste the code into its document. Select the code you just pasted and copy it again. Close Notebook.

    3- Open the Excel Workbook.

    4- Press Alt+F11 to open the VBA editor.

    5- Select Module from the Insert menu. This should give you a new module (named Module 1 if there are no other modules in the Workbook) with an empty area in the code edit window.

    6- Paste the code into the code window.

    7- Click on the "X" in the upper right corner to close the VBE editor.

    8- Save the Workbook.

    Before you try to execute the code, make a backup copy of the workbook in case the macro does not perform as expected.

    To run the macro, do the following:

    1- Open the workbook.

    2- Select Macro from the Tools menu, then select Macros from the fly-out menu.

    3- Find MoveToTerminated in the list of macros and select it.

    4- Click on the Run button.
    Legare Coleman

  9. #9
    Star Lounger
    Join Date
    Aug 2001
    Location
    Bloomington, Indiana, USA
    Posts
    75
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Automatically move rows/cells (was delete row)

    Thank you so much. I have followed your directions, and have run into this problem: When I copy the code from notepad to VBA, I get an error message: Compile error: Expected: =

    The error is showing inthis line: Worksheets("Terminated").Range("A1").Offset(lLastP asteRow, 0)

    Here is the code as I pasted it:

    Public Sub MoveToTerminated()
    Dim I As Long, lLastRow As Long, lLastPasteRow As Long
    Dim datRow As Date, datToday As Date
    Dim rng As Range

    lLastRow = Worksheets("Current").Range("K65536").End(xlUp).Ro w - 1
    lLastPasteRow = Worksheets("Terminated").Range("K65536").End(xlUp) .Row

    datToday = Date
    For I = lLastRow To 4 Step -1
    With Worksheets("Current").Range("K1")
    Set rng = .Offset(I, 0)
    datRow = DateValue(rng.Value)
    If datRow < datToday Then
    rng.EntireRow.Copy_
    Worksheets("Terminated").Range("A1").Offset(lLastP asteRow, 0)
    rng.EntireRow.Delete
    lLastPasteRow = lLastPasteRow + 1
    End If
    End With
    Next I
    End Sub


    Thanks,
    Greg <img src=/S/dizzy.gif border=0 alt=dizzy width=15 height=15>

  10. #10
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Automatically move rows/cells (was delete row)

    The problem is in this part:

    rng.EntireRow.Copy_
    Worksheets("Terminated").Range("A1").Offset(lLastP asteRow, 0)

    The underscore character _ is the line continuation character in VB. It indicates that the instruction on the line with the underscore will be continued on the next line.

    There *must* be a space between the text and the underscore. So it should be

    rng.EntireRow.Copy _
    Worksheets("Terminated").Range("A1").Offset(lLastP asteRow, 0)

    (as in both my post and Legare's post)

    Or, if you prefer, you can put the instruction on one line:

    rng.EntireRow.Copy Worksheets("Terminated").Range("A1").Offset(lLastP asteRow, 0)

  11. #11
    Silver Lounger
    Join Date
    Mar 2001
    Location
    Springfield, Ohio, USA
    Posts
    2,136
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Automatically move rows/cells (was delete row)

    You need to copy Legare's code from the message to Word or WordPad, not NotePad. This gets rid of the HTML formatting. Then select it again and copy it to VBA. It should be nicely indented like the post. Your error was actually on the previous line: there must be a blank space before the underscore. HTH --Sam
    <font face="Comic Sans MS">Sam Barrett, CACI </font face=comic>
    <small>And the things that you have heard... commit these to faithful men who will be able to teach others also. 2 Timothy 2:2</small>

  12. #12
    Uranium Lounger
    Join Date
    Dec 2000
    Location
    Salt Lake City, Utah, USA
    Posts
    9,508
    Thanks
    0
    Thanked 6 Times in 6 Posts

    Re: Automatically move rows/cells (was delete row)

    In addition to Hans' and Sammys' advice, occasionally you'll still have a line of code broken as a result of forced word wrap; so until you get proficient with code, after you post the code into the VBE, edit it against the post so it's exactly the same.
    -John ... I float in liquid gardens
    UTC -7ąDS

  13. #13
    Star Lounger
    Join Date
    Aug 2001
    Location
    Bloomington, Indiana, USA
    Posts
    75
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Automatically move rows/cells (was delete row)

    I have the code formatted properly now by comparing it with the post, I think. I am running into another problem now with a type mismatch. When I debug the code, it highlights the line datRow = DateValue(rng.Value) when I hover the mouse over the sections of code I get : 8/1/2002 over the datRow section and rng.Value = Empty over the rng.Value section.

    I have attached a "sterilized" version of the file for reference. Any help would be appreciated.
    Attached Files Attached Files
    Greg <img src=/S/dizzy.gif border=0 alt=dizzy width=15 height=15>

  14. #14
    Uranium Lounger
    Join Date
    Dec 2000
    Location
    Salt Lake City, Utah, USA
    Posts
    9,508
    Thanks
    0
    Thanked 6 Times in 6 Posts

    Re: Automatically move rows/cells (was delete row)

    Greg, I think it's blowing up on the blank cells such as at K12, K27, etc. This should fix that:

    Public Sub MoveToTerminated()
    Dim I As Long, lLastRow As Long, lLastPasteRow As Long
    Dim datRow As Date, datToday As Date
    Dim rng As Range
    lLastRow = Worksheets("Current").Range("K65536").End(xlUp).Ro w - 1
    lLastPasteRow = Worksheets("Terminated").Range("K65536").End(xlUp) .Row
    datToday = Date
    For I = lLastRow To 4 Step -1
    With Worksheets("Current").Range("K1")
    Set rng = .Offset(I, 0)
    <font color=red>If TypeName(rng.Value) = "Date" Then
    datRow = rng.Value</font color=red>
    If datRow < datToday Then
    rng.EntireRow.Copy _
    Worksheets("Terminated").Range("A1").Offset(lLastP asteRow, 0)
    rng.EntireRow.Delete
    lLastPasteRow = lLastPasteRow + 1
    End If
    <font color=red>End If</font color=red>
    End With
    Next I
    End Sub

    Test it on some -backed up- real data to see if it runs OK. (And you should probably resolve the issue of those blank cells from a business data perspective.)
    -John ... I float in liquid gardens
    UTC -7ąDS

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •