Delete

gnusmas

Board Regular
Joined
Mar 5, 2014
Messages
186
Hi, friends
here i just need <acronym title="visual basic for applications">vba</acronym> code to delete last line of each group!!

Sheet 1

050631394449
061822293744
040812162744
092426374446
052021263147
081022263137
081426363942
050934383942
042227363846
062122374142
031618193742
071022253243
021925303239
011214313246
101921243335

<tbody>
</tbody>


Sheet 2 output like this

050631394449
061822293744
040812162744
092426374446
081022263137
081426363942
050934383942
042227363846
031618193742
071022253243
021925303239
011214313246

<tbody>
</tbody>


I apreciate so much your help!
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Maybe this UNTESTED


Code:
Sub MM1()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = 2 To lr
    If Range("A" & r + 1).Value = "" Then
        Rows(r).Delete
    End If
Next r
End Sub
 
Upvote 0
Would something like this suffice?
Rich (BB code):
Sub Del()
  Dim rA As Range
  
  Application.ScreenUpdating = False
  Sheets("Sheet1").Copy After:=Sheets("Sheet1")
  For Each rA In ActiveSheet.UsedRange.SpecialCells(xlConstants).Areas
    rA.Rows(rA.Rows.Count).Delete
  Next rA
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
gnusmas,

Thanks for starting a new thread.

Do not let the length of the following macro fool you to think that it is not fast. It utilizes the method by Peter_SSs, and, two arrays in memory.

With your raw data in worksheet Sheet1, and, the results in worksheet Sheet2.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code:
Sub DeleteLastRowOfEachGroup()
' hiker95, 10/02/2014, ME809144
Dim a As Variant, o As Variant
Dim i As Long, j As Long
Dim lr As Long, lc As Long, c As Long
Dim Area As Range
Dim sr As Long, er As Long
With Sheets("Sheet1")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  ReDim o(1 To lr, 1 To lc)
  For Each Area In .Range("A1:A" & lr).SpecialCells(xlCellTypeConstants).Areas
    With Area
      sr = .Row
      er = sr + .Rows.Count - 1
      For i = sr To er - 1
        j = j + 1
        For c = 1 To lc
          o(j, c) = a(i, c)
        Next c
      Next i
      j = j + 1
    End With
  Next Area
End With
With Sheets("Sheet2")
  .Columns(1).Resize(, lc).ClearContents
  .Cells(1, 1).Resize(lr, lc).Value = o
  .Activate
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the DeleteLastRowOfEachGroup macro.
 
Last edited:
Upvote 0
Great Job thank you!


Would something like this suffice?
Rich (BB code):
Sub Del()
  Dim rA As Range
  
  Application.ScreenUpdating = False
  Sheets("Sheet1").Copy After:=Sheets("Sheet1")
  For Each rA In ActiveSheet.UsedRange.SpecialCells(xlConstants).Areas
    rA.Rows(rA.Rows.Count).Delete
  Next rA
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Here is another macro you could try (I think it should be pretty fast)...
Code:
Sub DeleteAboveBlankRows()
  Cells(Rows.Count, "A").End(xlUp).Offset(2).Value = "X"
  Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row + 1).SpecialCells(xlBlanks).Offset(-1).EntireRow.Delete
  Cells(Rows.Count, "A").End(xlUp).Clear
End Sub
 
Upvote 0
Here is another macro you could try (I think it should be pretty fast)...
Code:
Sub DeleteAboveBlankRows()
  Cells(Rows.Count, "A").End(xlUp).Offset(2).Value = "X"
  Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row [COLOR="#FF0000"][B]+ 1[/B][/COLOR]).SpecialCells(xlBlanks).Offset(-1).EntireRow.Delete
  Cells(Rows.Count, "A").End(xlUp).Clear
End Sub
Rick, a couple of comments. From the look of the sample data, the first comment is probably not relevant here but the second could well be.

1. If there was an isolated blank cell in column A among a particular 'block' of data this code (& Michael's) will delete a row in the middle of the block.

2. This happened to me when I tested your code. If the sheet's used range extends past the last data currently in column A (from formatting, previously used cells, data in other columns etc) then this code deletes the bottom cell in column A as the 'X' will have been deleted already. I'm not sure why you have that "+ 1" in there? Removing that would stop this situation without detriment as far as I can see.
 
Upvote 0
Rick, a couple of comments. From the look of the sample data, the first comment is probably not relevant here but the second could well be.

1. If there was an isolated blank cell in column A among a particular 'block' of data this code (& Michael's) will delete a row in the middle of the block.
I assumed the data the OP posted was fully representation, so my assumption was that the only blanks in Column A (within the UsedRange) would be between data blocks as shown.

2. This happened to me when I tested your code. If the sheet's used range extends past the last data currently in column A (from formatting, previously used cells, data in other columns etc) then this code deletes the bottom cell in column A as the 'X' will have been deleted already. I'm not sure why you have that "+ 1" in there? Removing that would stop this situation without detriment as far as I can see.
I think that +1 was left over from some of the tests I did where the last data row was at the end of the UsedRange... as I remember it, it was an attempt to make SpecialCells(xlBlanks) see the blank after the end of the UsedRange... obviously, I forgot to remove it after I hit upon the idea of forcing the UsedRange to encompass it by inserting a text character in the row after it. Strange, though, I could have sworn I tested for the problem you raised, but it would seem obvious that I didn't. Thanks for noting and correcting that code line for me... I appreciate it.


OFF_TOPIC: Peter, did you manage to catch my last message over in the private MVP sub-forum in the "What I really..." thread?
 
Upvote 0

Forum statistics

Threads
1,213,562
Messages
6,114,326
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top