"Add to Selection" , SendKeys, Delete Nth Row

[EphesiansSix]

Hi All,

I have tried hard to figure this out, but to no avail. All I want to
do is select multiple rows (or multiple anything for that matter) in
VBA, mimicking when you use CTRL-Click in Excel. I have tried two
approchaes:

Approach 1: Use some sort of "add to selection" method in VBA. Does
such a thing exist? The Macro Recorder just includes all the selected
rows into a single range.

Approach 2: Toggle the "Add to Selection" Mode, make the selections,
then toggle again. SHIFT-F8 does this in Excel, so I tried to use
SendKeys to do it:

SendKeys "+{F8}"

Sendkeys doesn't quite work like I thought it did, first doing nothing
when I step through the code, then when I run the code, it puts the
keystrokes into the code iteself! (Example: SendKeys "Hello" puts
"Hello" in the code wherever the cursor was)

While I'm at it, I'll explain the context as well. I need to delete all
rows except the Nth rows of a worksheet which was created by a numerical
simulation. The method below works, but takes a while. I figured that
selecting all the "dead" rows first and then deleting them with one
delete command would be faster (I already have disabled screen updating
and automatic calcs.)


Code:
--------------------
Sub proDeleteRows()
Dim varRecordInterval as Double 'Interval to keep the data
varRecordInterval = 5
Dim varTimeStep As Double 'Timestep used for calculating the data
varRecordInterval = 0.2

Dim varNthKeep As Integer 'Variable to store the "row keeping" interval
varNthKeep = varRecordInterval / varTimeStep ' Calculates N
Dim vanNthCounter As Integer ' Counter used in For Loop
vanNthCounter = 1

'Select the last row of the simulation and temporarily paste its values
'into row 3 so this last row is not lost during the deletion.

Rows(varSimCounter).Select
Selection.Copy
Rows(3).Select
Selection.PasteSpecial Paste:=xlPasteValues


Dim i As Integer 'Counter for the FOR Loop, initialized at 6 (the first non-zero data row)
i = 6
Dim k As Integer 'Counts number of data rows remaining after deletion
k = 0

For i = 6 To varSimCounter / varNthKeep + 10 'Loop from row 6 (first non-zero entry) to where the data should end, plus a buffer to handle any remainder from the division.

If vanNthCounter <> varNthKeep Then ' Check to see if the counter is on N
'If not, then:
Rows(i).Select 'Select the i'th row
Selection.Delete Shift:=xlUp 'Delete the row
i = i - 1 'Decrement the loop so it stays on the same row. Note when you delete a row, those below are shifted up.
vanNthCounter = vanNthCounter + 1 'Increment the N counter

ElseIf vanNthCounter = varNthKeep And Cells(k + 1, 1) <> "" Then 'If it is on an N row and this is not the last row:
k = k + 1 'Don't delete it, just increment the "number of data rows still left after deletion" counter
vanNthCounter = 1 'Reset the N counter, and allow the loop to go to the next row.

End If

Next

'Paste that original last data row onto the end of the new data.
Rows(3).Select
Selection.Cut
Rows(k + 1).Select
ActiveSheet.Paste

End Sub

--------------------



Any help to make this one work better, or a better "delete all except
Nth Row" technique would be appreciated.

Thanks!

-Alex

 

[Tom Ogilvy]

dim rng as Range

.. . .

If vanNthCounter <> varNthKeep Then ' Check to see if the counter is on N
' this is a row to delete
if rng is nothing then
set rng = rows(i)
else
set rng = union(rng,rows(i))
end if



.. . .

Next

if rng is nothing then
rng.Delete
end if

 

[visdev1]

Sub DeleteRows()
'\\TRY

Dim TopAddress As String
Dim BottomAddress As String
Dim BottomRow As Long

Dim x As Long
Dim y As Long
Dim TopRow As Long

TopRow = 6
'This will get you the addresses of the cells you want to delete and then
'use range to delete them

TopAddress = Cells(TopRow, 1).Address
BottomRow = Cells(TopRow, 1).End(xlDown).Row - 1
BottomAddress = Cells(BottomRow, 1).Address
Range(TopAddress, BottomAddress).Delete
'\\
'------------------------------------------------
Stop
'//OR TRY
'If you want to delete one row at a time
TopRow = 6
y = TopRow + Range("A1").End(xlDown).Row - 1 ' minus 1 to skip deleting
last row
For x = y - 1 To 1 Step -1 'delete from bottom to top
Rows(TopRow + x).Delete
Next x
'//

End Sub

 

[EphesiansSix]

Thanks to both Tom and visdev1.

Tom, I implemented yours and it works well. It taught me "Union" an
"Is Nothing." I just made one small change so if the range is -not
empty, the deletion runs.

For those interested in a snippet, here's the revised code to "Delet
all rows except the Nth one":


Code
-------------------
Sub proDeleteRows()
'Note that the variables used to determine "varNthKeep" are designed for numerical simulation in this example, but varNthKeep could be assigned whatever way works best for your application.

Application.StatusBar = "Now Deleting Rows."

Dim varRecordInterval As Double 'Interval to Keep data (i.e. every 5 seconds)
Dim varTimeStep As Double 'Timestep used in the simulation
Dim varLastRow As Integer
varLastRow = 'Assign this somehow.

Dim varNthKeep As Integer 'Variable to store the "row keeping" interval
varNthKeep = varRecordInterval / varTimeStep ' Calculates N
Dim varNthCounter As Integer ' Counter used in For Loop
varNthCounter = 1
Dim varDeleteRange As Range

'Select the last row of the simulation and temporarily paste its values
'into row 3 so this last row is not lost during the deletion.

Rows(varLastRow).Select
Selection.Copy
Rows(3).Select
Selection.PasteSpecial Paste:=xlPasteValues


Dim i As Integer 'Counter for the FOR Loop, initialized at 6 (the first non-zero data row)
i = 6
Dim k As Integer 'Counts number of data rows remaining after deletion
k = 0

For i = 6 To varLastRow 'Loop from row 6 (first non-zero entry) to where the data should end, plus a buffer to handle any remainder from the division.

If varNthCounter <> varNthKeep Then ' Check to see if the counter is on N
'If not, then this is a row to delete.

If varDeleteRange Is Nothing Then 'If the range is still empty (first i row)
Set varDeleteRange = Rows(i) 'Give the range a value
Else
Set varDeleteRange = Union(varDeleteRange, Rows(i)) 'Add this row to the range
End If

varNthCounter = varNthCounter + 1 'Increment the NthCounter

ElseIf varNthCounter = varNthKeep And Cells(k + 1, 1) <> "" Then 'If it is on an N row and this is not the last row:
k = k + 1 'Don't mark for deletion, just increment the "number of data rows still left after deletion" counter
varNthCounter = 1 'Reset the N counter, and allow the loop to go to the next row.

End If

Next

If Not varDeleteRange Is Nothing Then
varDeleteRange.Delete
End If

'Paste that original last data row onto the end of the new data.
Rows(3).Select
Selection.Cut
Rows(k + 6).Select
ActiveSheet.Paste

End Su
-------------------



visdev, your method also looks like it would work if looped properly
and Union was used like in Tom's code. The trick is skipping every Nt
row in the deletion. I especially like using String as opposed t
Range. (Range variables look gigantic and confusing in the watc
window.)

Thanks again