Macro to delete rows except selected rows

[Jedit]

I have a worksheet filled with 600 columns of data.

Is there a macro that can prompt a user box to select any number of rows and then delete the remaining unselected rows?

Thanks,
Jedit

 

[patel45]

if you have a sheet empty, I suppose sheet2

Sub a()
Selection.Copy Sheets(2).Range("a1")
Cells.ClearContents
Sheets(2).UsedRange.Copy Range("a1")
Sheets(2).Cells.ClearContents
End Sub

 

[Peter_SSs]

Jedit

Perhaps this is what you mean?

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> DeleteUnwantedRows()<br>  <SPAN style="color:#00007F">Dim</SPAN> KeepRows <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN><br>  <br>  KeepRows = Application.InputBox(Prompt:="Enter NUMBER of rows to keep?", Type:=1)<br>  <SPAN style="color:#00007F">If</SPAN> TypeName(KeepRows) <> "Boolean" <SPAN style="color:#00007F">Then</SPAN><br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>    Rows(KeepRows + 1 & ":" & Rows.Count).Delete<br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br>  <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[Jedit]

Thank you for the code. I greatly appreciate it. Would it be possible for the user to select rows 5-16 and then have all other rows deleted or select rows 21-35 and have all other rows deleted?

 

[Peter_SSs]

Thank you for the code. I greatly appreciate it. Would it be possible for the user to select rows 5-16 and then have all other rows deleted or select rows 21-35 and have all other rows deleted?

See if this does what you want.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> KeepSelectedRows()<br>  <SPAN style="color:#00007F">With</SPAN> Selection<br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>    Rows("1:" & .Row - 1).Delete<br>    Rows(.Row + .Rows.Count & ":" & Rows.Count).Delete<br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br>  <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[patel45]

very good, but my code works also with non contiguous selection, it's possible to avoid the use of a support sheet ?

 

[Peter_SSs]

.. my code works also with non contiguous selection,

Only in limited circumstances.
Try it with a sheet as below with the green cells selected, or Sheet3 that I've shown below with green cells selected.

Also, if run it with the blue cells selected, it doesn't error but as well as deleting the unwanted rows, it also deletes the data in the yellow cells. Remember, the OP has 600 columns of data with no mention of deleting them..

Excel Workbook
	A	B	C	D	E
1	1	data	data	data	data
2	2	data	data	data	data
3	3	data	data	data	data
4	4	data	data	data	data
5	5	data	data	data	data
6	6	data	data	data	data
7	7	data	data	data	data
8	8	data	data	data	data
9	9	data	data	data	data
10	10	data	data	data	data
Sheet1

.. it's possible to avoid the use of a support sheet ?

Yes, I think this does disjoint selections and without a helper sheet.

Sub RemoveUnselectedRows()
  Dim lr As Long, fr As Long, i As Long
  Dim addr As String
  Dim Bits
  
  Bits = Split(Replace(Replace(Selection.Address, ",", ""), ":", ""), "$")
  fr = Rows.Count
  Application.ScreenUpdating = False
  For i = 0 To UBound(Bits)
    If IsNumeric(Bits(i)) Then
      If Bits(i) > lr Then lr = Bits(i)
      If Bits(i) < fr Then fr = Bits(i)
    End If
  Next i
  On Error Resume Next
  Rows(lr + 1 & ":" & Rows.Count).Delete
  On Error GoTo 0
  For i = lr - 1 To fr + 1 Step -1
    If Intersect(Rows(i), Selection) Is Nothing Then
      Rows(i).Delete
    End If
  Next i
  On Error Resume Next
  Rows("1:" & fr - 1).Delete
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub

This code tested successfully on this sheet with all the green cells selected.

Excel Workbook
	A	B	C	D	E
1	1	data	data	data	data
2	2	data	data	data	data
3	3	data	data	data	data
4	4	data	data	data	data
5	5	data	data	data	data
6	6	data	data	data	data
7	7	data	data	data	data
8	8	data	data	data	data
9	9	data	data	data	data
10	10	data	data	data	data
Sheet3

 

[patel45]

many thanks Peter !!