Need VBA help with deleting rows and/or cells based on a certain cell

[aaronp]

Im trying to make a script that help me elimate some useless info on a sheet so I can make some charts faster. I know this is quite a headache now but will save me soo much time after it is done. Here is what I want to happen...

Column B is going to look similar to this

Row 1 : F130201
Row 2 : F130202
Row 3 : F130203
Row 4 : Pumpout
Row 5 : F130204
Row 6 : Jumbo
Row 7 : F130205

It doesn't actually say Row #, I just put that so you new it was the next row. Anyway, this goes on for hundreds of rows. I need a script that will check the contents of column B, if its one that starts with F######, leave it alone, but if it says "pumpout", i want to delete the entire row and shift cells up. If say, row 6 column B says "Jumbo", I want to delete A6 & B6, shift cells up, delete C5:J5 and shift cells up.

Im sorry if this is confusing and/or really difficult but I would so much appreciate someones help with this. Ive been trying to figure it out on my own for quite some time now and I just can't figure it out.

[tigeravatar]

aaronp,

Something like this?

Sub tgr()
    
    Dim rngCheck As Range
    Dim CheckCell As Range
    Dim rngDel As Range
    
    Set rngCheck = Range("A1", Cells(Rows.Count, "A").End(xlUp))
    
    For Each CheckCell In rngCheck.Cells
        If Not (Left(CheckCell.Text, 1) = "F" And Len(Mid(CheckCell.Text, 2)) = 6 And IsNumeric(Mid(CheckCell.Text, 2))) Then
            Select Case (rngDel Is Nothing)
                Case True:  Set rngDel = CheckCell
                Case Else:  Set rngDel = Union(rngDel, CheckCell)
            End Select
        End If
    Next CheckCell
    
    If Not rngDel Is Nothing Then rngDel.EntireRow.Delete xlShiftUp
    
    Set rngCheck = Nothing
    Set CheckCell = Nothing
    Set rngDel = Nothing
    
End Sub

[aaronp]

That was one super fast reply...I just logged back into to make an edit not 5 minutes later. Thank you!

I only want to delete rows from row 5 and beyond. Everything on rows 1 - 4 must stay. hopefully that isnt too much to ask

[tigeravatar]

No problem, just change it from "A1" to "A5" when you define rngCheck (you can change the column letter too if you need to look in a different column)

[aaronp]

Sorry, I forgot another part of important information. This is going to be triggered by a button on sheet 1 "macros" and the sheet that is going to be edited is sheet 2 "DC Data".

So sorry about that! I was more concerned with explaining it correctly.

Update: So I figured out how to get the macro to work from a different sheet and script work absolutely perfectly on everything except the special circumstance where I need it to do something a little different when it sees "jumbo". Maybe you skipped over that part or I didn't explain it well enough. If you need more info, please let me know. Thank you soooo much for your help!!! You have no idea how much this is gonna help me in the future.

[tigeravatar]

Updated code:

Sub tgr()
    
    Dim ws As Worksheet
    Dim rngCheck As Range
    Dim CheckCell As Range
    Dim rngDelAll As Range
    Dim rngDelSpecial As Range
    Dim DelArea As Range
    
    Set ws = Sheets("DC Data")
    Set rngCheck = ws.Range("A5", ws.Cells(Rows.Count, "A").End(xlUp))
    
    For Each CheckCell In rngCheck.Cells
        If Not (Left(CheckCell.Text, 1) = "F" And Len(Mid(CheckCell.Text, 2)) = 6 And IsNumeric(Mid(CheckCell.Text, 2))) Then
            If CheckCell.Text = "Jumbo" Then
                Select Case (rngDelSpecial Is Nothing)
                    Case True:  Set rngDelSpecial = Union(CheckCell.Resize(, 2), CheckCell.Offset(-1, 2).Resize(, 2))
                    Case Else:  Set rngDelSpecial = Union(rngDelSpecial, CheckCell.Resize(, 2), CheckCell.Offset(-1, 2).Resize(, 2))
                End Select
            Else
                Select Case (rngDelAll Is Nothing)
                    Case True:  Set rngDelAll = CheckCell
                    Case Else:  Set rngDelAll = Union(rngDelAll, CheckCell)
                End Select
            End If
        End If
    Next CheckCell
    
    If Not rngDelAll Is Nothing Then rngDelAll.EntireRow.Delete xlShiftUp
    If Not rngDelSpecial Is Nothing Then rngDelSpecial.Delete xlShiftUp
    
    Set ws = Nothing
    Set rngCheck = Nothing
    Set CheckCell = Nothing
    Set rngDelAll = Nothing
    Set rngDelSpecial = Nothing
    Set DelArea = Nothing
    
End Sub

[aaronp]

That seems to do the same thing. I'm not sure if you just gave me a template to work with or not. I'm not sure how to edit what gets deleted when it doesn't specify the actual cell letters. Everything is all good except the rows with "Jumbo" in it. Nothing from the previous row is being deleted when it sees "Jumbo"

Hopefully this will help:

If B7 = Jumbo
Delete A7:B7 & C6:O6

Thanks again! You got me on the home stretch...for this macro anyway. Got a couple more to tackle after this one gets finalized.

[tigeravatar]

aaronp,

I have included an example file (attached) to demonstrate that the macro does delete the correct cells properly. Highlighted red is the row with "Pumpout" and highlighted yellow are the intended cells to delete for "Jumbo". When you click the button, you'll see that only the highlighted cells get deleted, as intended.

[tigeravatar]

The updated code I provided does that, but only for A7:B7 and C6:D6. You'll need to change the resize to be the appropriate length. it is currently 2 for columns (C and D), though changing from 2 to 13 will correct that to be 13 columns (C through O).

So basically, change both instances of

CheckCell.Offset(-1, 2).Resize(, 2)

To be this instead:

CheckCell.Offset(-1, 2).Resize(, 13)

[aaronp]

Yea I got it to work but there is an error somewhere in there...somehow the data is getting staggered a little bit. I'm sure it has something to do with the Jumbo part. Not an error on your part, there is probably something I'm not considering into in the whole process. This would probably be easier if I just uploaded the files so you could see for yourself instead of me trying to explain it. Would you mind looking at them?

[tigeravatar]

As long as they don't contain any confidential or personal information, I can take a look at it. Just be sure to have both a Before and After page so I can see what you're starting with and what the expected result it.

[aaronp]

I have attached the 2 files that are in use. DC charts is the file that contains what we are working on. Macro 1 uses the Daily Transfer Log file to update the DC Data sheet, so you will have to change the location of this file in module 1 so you can do trials on it. Macro 2 contains the code you have created for me. Macros 3-5 have not been created yet. I also added a new sheet, DC Data (What I Expected) so you could see what I am looking to get.

Thank you sooo much!

[tigeravatar]

aaronp,

Alright, after some trial and error, I think this is what you're looking for:

Sub DeleteData()
    
    Dim ws As Worksheet
    Dim rngCheck As Range
    Dim CheckCell As Range
    Dim rngDel As Range
    Dim lOffset As Long
    
    Set ws = Sheets("DC Data")
    Set rngCheck = ws.Range("B5", ws.Cells(Rows.Count, "B").End(xlUp))
    If rngCheck.Row < 5 Then Exit Sub   'No data
    
    For Each CheckCell In rngCheck.Cells
        If Not (Left(CheckCell.Text, 1) = "F" And Len(Mid(CheckCell.Text, 2)) = 6 And IsNumeric(Mid(CheckCell.Text, 2))) Then
            If CheckCell.Text <> "Jumbo" Then
                Select Case (rngDel Is Nothing)
                    Case True:  Set rngDel = CheckCell
                    Case Else:  Set rngDel = Union(rngDel, CheckCell)
                End Select
            End If
        End If
    Next CheckCell
    
    If Not rngDel Is Nothing Then
        rngDel.EntireRow.Delete xlShiftUp
        Set rngDel = Nothing
    End If
    
    Set rngCheck = ws.Range("B5", ws.Cells(Rows.Count, "B").End(xlUp))
    If rngCheck.Row < 5 Then Exit Sub   'No data
    
    For Each CheckCell In rngCheck.Cells
        If CheckCell.Text = "Jumbo" Then
            lOffset = 3 - (Len(Trim(CheckCell.Offset(-1, 3).Text)) > 0)
            Select Case (rngDel Is Nothing)
                Case True:  Set rngDel = CheckCell.Offset(, -1).Resize(, 2)
                Case Else:  Set rngDel = Union(rngDel, CheckCell.Offset(, -1).Resize(, 2))
            End Select
            Set rngDel = Union(rngDel, CheckCell.Offset(-1, lOffset).Resize(, 15 - (lOffset = 3)))
        End If
    Next CheckCell
    
    If Not rngDel Is Nothing Then rngDel.Delete xlShiftUp
    
    Set ws = Nothing
    Set rngCheck = Nothing
    Set CheckCell = Nothing
    Set rngDel = Nothing
    
End Sub

[aaronp]

I made a mistake on the sheet you were using for comparison..... I forgot to delete columns c,d & e on the previous rows with the "jumbo". Hopefully, it's just a matter of adjusting a couple numbers in the code like you had me do previously. I gotta be getting on your nerves by now...I'm terribly sorry.

Update

I changed this:

If CheckCell.Text = "Jumbo" Then
      lOffset = 3 - (Len(Trim(CheckCell.Offset(-1, 3).Text)) > 0)
      Select Case (rngDel Is Nothing)
            Case True:  Set rngDel = CheckCell.Offset(, -1).Resize(, 2)
            Case Else:  Set rngDel = Union(rngDel, CheckCell.Offset(, -1).Resize(, 2))
      End Select
      Set rngDel = Union(rngDel, CheckCell.Offset(-1, lOffset).Resize(, 15 - (lOffset = 3)))
End If

To this:

If CheckCell.Text = "Jumbo" Then
      lOffset = 0 - (Len(Trim(CheckCell.Offset(-1, 0).Text)) > 0)
       Select Case (rngDel Is Nothing)
            Case True:  Set rngDel = CheckCell.Offset(, -1).Resize(, 2)
            Case Else:  Set rngDel = Union(rngDel, CheckCell.Offset(, -1).Resize(, 2))
       End Select
       Set rngDel = Union(rngDel, CheckCell.Offset(-1, lOffset).Resize(, 15 - (lOffset = 0)))
End If

This seems to have done the trick. If you can confirm this is what I should have done, I will mark this thread as solved. I just want to verify that I didnt change too much. Thanks again!

[tigeravatar]

aaronp,

That looks good to me