PDA

View Full Version : Need help with delete



BENatUSGS
07-02-2010, 09:33 AM
Hi all,
So I have this code that code from the internet and have been trying to modify it but I can’t seem to get it to run the way I want.
Sub Example1()
Dim lLastRow As Long
Dim rngToCheck As Range

Application.ScreenUpdating = False

With Sheet1
'if the sheet is empty then exit...
If Application.CountA(.Cells) = 0 Then Exit Sub

'find the last row in the worksheet
lLastRow = Get_Last_Row(.Cells)

Set rngToCheck = .Range(.Cells(1, 1), .Cells(lLastRow, 1))
End With

If rngToCheck.Count > 1 Then
'if there are no blank cells then there will be an error
On Error Resume Next
rngToCheck.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Else
If IsEmpty(rngToCheck) Then rngToCheck.EntireRow.Delete
End If

Application.ScreenUpdating = True
End Sub
As you can see, this code will look at column A and if there is a blank cell in that column it will delete the entire row. For what I am doing, I need the macro to delete the entire row if any of the cells are blank from column A to V. Does anyone know how to format the range to do this?
Thanks,
Benjamin

Bob Phillips
07-02-2010, 10:10 AM
Untested



Sub Example1()
Dim lLastRow As Long
Dim rngToCheck As Range
Dim i As Long

Application.ScreenUpdating = False

With Sheet1
'if the sheet is empty then exit...
If Application.CountA(.Cells) = 0 Then Exit Sub

'find the last row in the worksheet
lLastRow = Get_Last_Row(.Cells)

Set rngToCheck = .Range(.Cells(1, 1), .Cells(lLastRow, 1))
End With

If rngToCheck.Count > 1 Then

For i = lLastRow To 1 Step -1

If Application.CountIf(Cells(i, 1).Resize(, 22), "=") <> 0 Then

Cells(i, 1).EntireRow.Delete
End If
Next rng
End If

Application.ScreenUpdating = True
End Sub

BENatUSGS
07-02-2010, 10:42 AM
Thanks xld!
Just a quick question though. This macro seems to delete a filled row with letters. So even if the row does not have a blank it is still removing rows with letters. Any way to fix this?
Thanks
Benjamin

GTO
07-02-2010, 04:48 PM
Greetings Benjamin from a fellow Arizonan,

Presume no header row...


Option Explicit

Sub exa()
Dim _
rngLastRow As Range, _
ary As Variant, _
x As Long, _
y As Long

Set rngLastRow = RangeFound(Sheet1.Range("A:V"), , Sheet1.Cells(1))

If rngLastRow Is Nothing Then Exit Sub

ary = Sheet1.Range(Sheet1.Range("A1"), Sheet1.Cells(rngLastRow.Row, "V")).Value

For x = UBound(ary, 1) To LBound(ary, 1) Step -1
For y = LBound(ary, 2) To UBound(ary, 2)
If ary(x, y) = vbNullString Then
Sheet1.Rows(x).Delete
Exit For
End If
Next
Next
End Sub

Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

Hope that helps,

Mark

p45cal
07-02-2010, 05:24 PM
How do you decide how far down you go? I've included a commented-out line with an alternative.Sub blah()
Dim xxx As Range, yyy As Range
With Sheet1
lLastRow = Get_Last_Row(.Cells)
'lLastRow = Get_Last_Row(.Columns("A:V"))'perhaps instead of the line above.
On Error Resume Next
Set xxx = Range(.Cells(1, 1), .Cells(lLastRow, "V")).SpecialCells(xlCellTypeBlanks).EntireRow
On Error GoTo 0
If Not xxx Is Nothing Then Union(xxx, xxx).Delete
End With
End Sub

BENatUSGS
07-06-2010, 12:41 PM
Hey all
I am not sure what the problem is all these codes work fine when I try them on their own. When I try to implement them into my macro they all delete everything on that worksheet. I’m not sure how much of my code I can include in a post but I will try to put as much as possible so maybe you guys/gals can come up with some ideas.

By the way, my worksheets do have header rows from A to V

Annss = MsgBox("You entered ABORT. Would you like to remove last row?", vbYesNo)
'This is the code the works by itself but not when put into this macro
Select Case Annss
Case vbYes
Application.ScreenUpdating = False

With Sheet1
'if the sheet is empty then exit...
If Application.CountA(.Cells) = 0 Then Exit Sub

'find the last row in the worksheet
lLastRow = Get_Last_Row(.Cells)

Set rngToCheck = .Range(.Cells(1, 1), .Cells(lLastRow, 1))
End With

If rngToCheck.Count > 1 Then

For i = lLastRow To 1 Step -1

If Application.CountIf(Cells(i, 1).Resize(, 22), "=") <> 0 Then

Cells(i, 1).EntireRow.Delete
End If
Next
End If
Application.ScreenUpdating = True

'you can ignore this next case
QWERT = MsgBox("Did you enter sample data for this particular result data?", vbYesNo)
Select Case QWERT
Case vbYes
Worksheets("Sample").UsedRange.SpecialCells(xlCellTypeLastCell).EntireRow.Delete
Case vbNo
GoTo z1
End Select
Case vbNo
GoTo z1
End Select

z1:
Ans = MsgBox("Would you like to enter more data?", vbYesNo)
Select Case Ans
Case vbYes
GoTo a2
Case vbNo
Anss = MsgBox("Would you like to save this workbook?", vbYesNo)
Select Case Anss
Case vbYes
NewName = Application.GetSaveAsFilename
ThisWorkbook.SaveAs Filename:=NewName
Case vbNo
End Select
End Select
End Sub

The reason I need to remove the row when ABORT is typed is because it will leave some empty cells in the row. My script is set up to put new data into the next available cell. So if the user only fills from A:P instead of going all the way from A:V it will cause problems the next time they try to enter data. This is why I want the option of deleting the last used row so that the user can use the ABORT command and just reenter the data later without the possibility of data going into the incorrect cell.
If you have any questions about what I’m asking feel free to ask. The odds of me correctly describing what I’m looking for is slim

Thanks
Ben

p45cal
07-06-2010, 01:59 PM
There may be a problem with
If Application.CountIf(Cells(i, 1).Resize(, 22), "=") <> 0 Then
Cells(i, 1).EntireRow.Delete in that it's uncertain which sheet is being referred to. So:
1. Where is this code housed? In a sheet's code module or a standard code module.
2. Is the module even in the same workbook as the one you're trying to change?
3. If in a standard code module, is sheet1 always guaranteed to be the active sheet. (Note that Sheet1 is a code name and not necessarily the same sheet as Sheet1 on the tab.)

BENatUSGS
07-08-2010, 08:46 AM
There may be a problem with
If Application.CountIf(Cells(i, 1).Resize(, 22), "=") <> 0 Then
Cells(i, 1).EntireRow.Delete in that it's uncertain which sheet is being referred to. So:
1. Where is this code housed? In a sheet's code module or a standard code module.
2. Is the module even in the same workbook as the one you're trying to change?
3. If in a standard code module, is sheet1 always guaranteed to be the active sheet. (Note that Sheet1 is a code name and not necessarily the same sheet as Sheet1 on the tab.)

Well, if I understand what you are saying, the code is housed in a module saved to my personal vba er… sheet (VBAProject (PERSONAL.XLSB)). I have a button added to my tool bar that runs the macro on a new workbook every time I click on it.
I didn’t know that sheet1 is used as a code name. I have a part of my code that changes the names from sheet 1 & 2 to “Sample” and “Result”. Could this possibly be a problem to why the code I take from this forum doesn’t work in my macro but works when it stands on its own module?
Thanks
Ben

p45cal
07-08-2010, 11:18 AM
Two things to try:
1. Assuming you want this to work on the active sheet when you click the toolbar button, add the two full stops in red below to the code cited earlier:If Application.CountIf(.Cells(i, 1).Resize(, 22), "=") <> 0 Then
.Cells(i, 1).EntireRow.Delete

There's no space eiter side of the full stop, I just used a larger font to highlight them)

2. Use my suggested code in message #5 but replace:
With Sheet1
with:
With Activesheet


Another possible source of problems is the function or sub Get_Last_Row. While you pass as an argument cells on a specific sheet to it, does its code robustly adhere to that?
We haven't seen the code for this, so to verify, could you post that too?

BENatUSGS
07-15-2010, 08:41 AM
So I tried posting the rest of the code but it just keeps putting up a blank post. Any better ideas to get it all up here?

p45cal
07-15-2010, 09:00 AM
So I tried posting the rest of the code but it just keeps putting up a blank post. Any better ideas to get it all up here?Put the code in a .txt file, adding where each bit of code is housed. Or export the modules (right-click for the menu to do that) and attach them (after zipping?) to a post(s) here. Or upload the personal file and the workbook you're working on, zipped up into one file.

BENatUSGS
07-15-2010, 01:44 PM
Let me know if this works
Thanks
Ben

BENatUSGS
07-15-2010, 01:50 PM
Here we go

p45cal
07-15-2010, 04:46 PM
Here is a separate sub to delete any rows with blanks in:
For Result sheet columns A to T are checked
for the Sample sheet columns A to V are checked.
Call it where you will in your code by the single word:
LoseRowsWithBlanksIn

Sub LoseRowsWithBlanksIn()
Dim xxx As Range, yyy As Range
SheetsArray = Array("Result", "Sample")
For Each sht In SheetsArray
If sht = "Result" Then lastcolm = "T" Else lastcolm = "V"
With ThisWorkbook.Sheets(sht)
Set yyy = Intersect(.UsedRange, .Columns("A:" & lastcolm))
' Application.Goto yyy 'debug line to check right range is being checked.
On Error Resume Next
Set xxx = yyy.SpecialCells(xlCellTypeBlanks).EntireRow
On Error GoTo 0
If Not xxx Is Nothing Then Union(xxx, xxx).Delete
End With
Next sht
End Sub
I really fear for the integrity of the resulting data. The code has many goto instructions, so it's like spaghetti to try and follow. What, in English, do you want the following line to do?:If Worksheets("Result").Range("A65535").End(xlUp).Offset(1, 0) > Worksheets("Sample").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) Then GoTo pk
pk:
2 points about this, (a) the items either side of the '>' comparison operator I believe have to be the same, both blank cells, so they have to be equal. (b) if the statement was true then you ask the code to jump to pk, which is the very next line anyway, so this makes the If statement redundant.

The other point is that (and your initial request on this thread shows that you recognise this) you decide which row to put data in only by putting it directly below the last bit of that data in that same column. Rather, you should have a variable (representing a row number), set once for each new input sequence which is used to place data in that row, regardless of what's above it. But deciding just where in your code to set this variable is not so easy because of the code's spaghetti nature!