Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Delete Non-Randomly Chosen Rows
I am using a random number generator to pull a sample of rows from a larger
population. I use the Excel row numbers for the RNG. From here I've been adding a field and marking it with X then filtering to get my list of samples. This is cumbersome at best. Is there a way I can get Excel to delete entire rows based on a list I provide? e.g the RNG comes up with 9, 43, 84, etc. I want to delete all rows EXCEPT 9, 43, 84, etc. I want something I can copy and past the row numbers as a group into. The originial number of rows is dynamic and keep in mind that what was row 43 will become row 10 after the other rows are deleted so maybe it needs to start at the bottom. Help will be appreciated by many. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Delete Non-Randomly Chosen Rows
Hi John,
Try using the following two functions: '================== Function Invert(rngA As Range, Optional bUsedRange As Boolean, _ Optional rngB As Range) As Variant ' Author keepITcool http://tinyurl.com/agpz9 ' Adapted from Norman Jones 2004 Jul 22 'Invert Selection ' Adapted from thread 2003 Oct 12 'Don't Intersect ' thread contributors Tom Ogilvy, Dave Peterson, Dana DeLouis Dim lCnt&, cVal As Collection, vItm As Variant Dim rUni As Range, rInt As Range, rRes As Range Dim iEvt%, iScr% With Application iEvt = .EnableEvents: .EnableEvents = False iScr = .ScreenUpdating: .ScreenUpdating = False End With Set cVal = New Collection If rngB Is Nothing Then If bUsedRange Then Set rngB = rngA.Parent.UsedRange Else Set rngB = Square(rngA) End If End If '2707: change to prevent inverting solid ' : 1st errtrap if rngA was passed via SpCells On Error GoTo theErrors Set rInt = Intersect(rngA, rngB) If rInt.Areas.Count = 1 Then Err.Raise vbObjectError + 1 Set rUni = Union(rngA, rngB) With rUni On Error Resume Next lCnt = rUni.SpecialCells(xlCellTypeAllFormatConditions). _ Areas.Count On Error GoTo theErrors If lCnt = 0 Then 'No existing Format conditions.. rUni.FormatConditions.Add 1, 3, 0 Intersect(rngA, rngB).FormatConditions.Delete Set rRes = .SpecialCells(xlCellTypeAllFormatConditions) rRes.FormatConditions.Delete Else Do 'Loop thru existing Validations 'Recurse Samevalidation store in cVal On Error Resume Next lCnt = 0 lCnt = .SpecialCells(xlCellTypeAllValidation).Count On Error GoTo theErrors If lCnt = 0 Then Exit Do With Intersect(rUni, _ rUni.SpecialCells(xlCellTypeAllValidation) _ .Cells(1).SpecialCells(xlCellTypeSameValidation)) With .Validation cVal.Add Array(.Parent, .Type, .AlertStyle, .Operator, _ .Formula1, .Formula2, _ .IgnoreBlank, .InCellDropdown, _ .ShowError, .ErrorTitle, .ErrorMessage, _ .ShowInput, .InputTitle, .InputMessage) .Delete End With End With Loop 'This is what we came for.. .Validation.Add 0, 1 Intersect(rngA, rngB).Validation.Delete Set rRes = .SpecialCells(xlCellTypeAllValidation) rRes.Validation.Delete 'Restore original validations If cVal.Count 0 Then For Each vItm In cVal With vItm(0).Validation .Add vItm(1), Abs(vItm(2)), vItm(3), vItm(4), vItm(5) .IgnoreBlank = vItm(6) .InCellDropdown = vItm(7) .ShowError = vItm(8) .ErrorTitle = vItm(9) .ErrorMessage = vItm(10) .ShowInput = vItm(11) .InputTitle = vItm(12) .InputMessage = vItm(13) End With Next End If End If End With theExit: With Application .EnableEvents = iEvt .ScreenUpdating = iScr End With If ObjPtr(rRes) 0 Then If rRes.Areas.Count 1 Then Set Invert = rRes Else On Error Resume Next lCnt = Intersect(rngA, rRes).Areas.Count On Error GoTo theErrors If lCnt = 0 Then Set Invert = rRes Else Set rRes = Nothing Err.Raise vbObjectError + 2 GoTo theErrors End If End If End If Exit Function theErrors: Select Case Err.Number Case vbObjectError + 1: vItm = _ "Solid input range. Cannot invert." Case vbObjectError + 2: vItm = _ "Complex result range. Cannot invert." Case Else: vItm = Err.Description End Select Invert = CVErr(xlErrRef) MsgBox vItm, vbCritical, "Error:Inverse Function" Resume theExit End Function '<<================= '================== Function Square(rng As Range) As Range 'Finds the 'square outer range' of a (multiarea) range Dim c1&, cn&, r1&, rn&, x1&, xn&, a As Range r1 = &H10001: c1 = &H101 For Each a In rng.Areas x1 = a.Row xn = x1 + a.Rows.Count If x1 < r1 Then r1 = x1 If xn rn Then rn = xn x1 = a.Column xn = x1 + a.Columns.Count If x1 < c1 Then c1 = x1 If xn cn Then cn = xn Next Set Square = rng.Worksheet.Cells(r1, c1). _ Resize(rn - r1, cn - c1) End Function '<<================= As an example of use, assume that the initial population range comprises rows 1:100 and that the retained range comprises the randomly selected rows 9, 43, 84: '================ Sub TestIt() Invert(Range("A1:A100"), , Range("A9, A43,A84")). _ EntireRow.Delete End Sub '<<================ --- Regards, Norman "John" wrote in message ... I am using a random number generator to pull a sample of rows from a larger population. I use the Excel row numbers for the RNG. From here I've been adding a field and marking it with X then filtering to get my list of samples. This is cumbersome at best. Is there a way I can get Excel to delete entire rows based on a list I provide? e.g the RNG comes up with 9, 43, 84, etc. I want to delete all rows EXCEPT 9, 43, 84, etc. I want something I can copy and past the row numbers as a group into. The originial number of rows is dynamic and keep in mind that what was row 43 will become row 10 after the other rows are deleted so maybe it needs to start at the bottom. Help will be appreciated by many. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Help to display chosen columns and rows | Excel Worksheet Functions | |||
how do i set to only see chosen rows and columns in excel | Excel Discussion (Misc queries) | |||
How do i sort rows randomly? | Excel Discussion (Misc queries) | |||
How can i randomly select 780 rows from 4000 rows of data | Excel Worksheet Functions | |||
Randomly fill in rows | Excel Programming |