selecting specific rows

[LeeRoy]

Hi boys,

I would like to create a macro that would select every other/third row (or column) in excel. I can use simple: Range("1:1,3:3,5:5,7:7,9:9,11:11,12:12,13:13,14:14,15:15").Select but only for sheets that do not have a lot of rows and I have to manually define the rows.

So how can I create macro that would select every second record in the file even if the file has 10.000 records?. Additional question would be how to define start position for macro (so as example select every second row starting from row 10.)

Thank you a lot!

Lee

[GTO]

Hi boys,

Eh? Not to be negative, but whilst stereotypically or statistically, males tend to dominate motor sports, math related "stuff" (like computer related), there are girls that contribute greatly as well. UNIVAC, COBOL, and for all of us, inventing the compiler come to mind...


Anyways, to your question...

So how can I create macro that would select every second record in the file even if the file has 10.000 records?.

Could you describe that bit? Do we find the first and last row in some particular column?

[Bob Phillips]

Eh? Not to be negative, but whilst stereotypically or statistically, males tend to dominate motor sports, math related "stuff" (like computer related), there are girls that contribute greatly as well. UNIVAC, COBOL, and for all of us, inventing the compiler come to mind...


And it's been a long time since some of us on the spear side were boys :cry2:

[Bob Phillips]

This might get you started


Dim rng As Range
Dim lastrow As Long
Dim i As Long

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
If lastrow > 2 Then

.Columns("A").Insert
.Range("A1").Value = "tmp"
.Range("A2").Resize(lastrow - 1).Formula = "=IF(ROW()=EVEN(ROW()),TRUE,"""")"
Set rng = .Range("A2").Resize(lastrow - 1).SpecialCells(xlCellTypeFormulas, xlLogical).EntireRow
.Columns("A").Delete
rng.Select
End If
End With

[LeeRoy]

Eh? Not to be negative, but whilst stereotypically or statistically, males tend to dominate motor sports, math related "stuff" (like computer related), there are girls that contribute greatly as well. UNIVAC, COBOL, and for all of us, inventing the compiler come to mind...


Anyways, to your question...
[/FONT][/SIZE][SIZE=2][FONT=tahoma]

Could you describe that bit? Do we find the first and last row in some particular column?

I don't need anything specific (finding first or last row). I just want that every second or nth row is selected in the whole sheet, that is all. And if possible if the start row can also be defined with vba. So for example select every nth row starting from row 10.

Thanks for help!

[jolivanes]

Eh? Not to be negative, but whilst stereotypically or statistically, males tend to dominate motor sports

Danica Patrick might not like the word dominate!!!!!

[snb]

Sub M_snb()
Range(Join(Filter([transpose(if(mod(row(1:100),3)=0,address(row(1:100),1),""))], "$"), ",")).EntireRow.Select
End Sub
or

Sub M_snb_001()
Range(Join(Filter([transpose(if(mod(row(1:100),3)=0,"A"& row(1:100),""))], "A"), ",")).EntireRow.Select
End Sub

[mancubus]

Sub M_snb()
Range(Join(Filter([transpose(if(mod(row(1:100),3)=0,address(row(1:100),1),""))], "$"), ",")).EntireRow.Select
End Sub
or

Sub M_snb_001()
Range(Join(Filter([transpose(if(mod(row(1:100),3)=0,"A"& row(1:100),""))], "A"), ",")).EntireRow.Select
End Sub

hi snb.

it throws RTE 1004: the item with the specified name wasn't found, if the upper row number exceeds;
- 125 for the first sub
- 176 for the second sub.

do you have any idea why?

i use Office2013.

[Bob Phillips]

It is probably caused by the string limit of 255 characters. Try using ROW(9000:10000), just 100 rows, but it will still fail.

That is the problem with using these so-called 'smart' one-liners, they look enticing, but so easily fall apart in real situations.

[GTO]

Hi mancubus,

Nice testing:thumb.

Bob has already given a correct answer, but since I wrote this to show you, I'll still post it.



Sub xxM_snb()
Dim addressString
Dim rng As Range

On Error GoTo FixIt
addressString = Join(Filter([transpose(If(mod(row(1:126),3)=0, address(row(1:126),1),""))], "$"), ",")
Debug.Print addressString
Debug.Print Len(addressString)
Set rng = Range(addressString)

On Error Resume Next
addressString = Join(Filter([transpose(If(mod(row(1:177),3)=0,"A"& row(1:177),""))], "A"), ",")
Debug.Print addressString
Debug.Print Len(addressString)
Set rng = Range(addressString)

If Err Then
MsgBox "Address string length exceeded 255 characters, length is: " & Len(addressString) & vbLf & vbLf & _
"Err number: " & Err.Number & vbLf & _
Err.Description

Set rng = Nothing
addressString = vbNullString
Err.Clear
Exit Sub
End If

Exit Sub
FixIt:

MsgBox "Address string length exceeded 255 characters, length is: " & Len(addressString) & vbLf & vbLf & _
"Err number: " & Err.Number & vbLf & _
Err.Description

Set rng = Nothing
addressString = vbNullString
Err.Clear
Resume Next

End Sub

As XLD says, the string argument supplied to Range can easily get too long.

Hope that helps,

Mark

[mancubus]

hey xld, GTO.

thanks, referring to post #1, boys :)

[snb]

If you think in alternative approaches (not in 'solutions' for every possible situation): everybody will be able to make an appropriate choice for the situation the code is meant for. That's the power of fora.

To overcome certain restrictions (if necessary):


Sub M_snb()
With Range("AA1:AA1000")
.Value = Evaluate("if(mod(row(" & .Address & "),3)=0,""~""," & .Address & ")")
.AutoFilter 1, "~"
.Offset(1).SpecialCells(12).EntireRow.Select
.AutoFilter
.ClearContents
End With
End Sub

[mancubus]

i regularly receive data in txt format.

most of the reports have "unnecessary" lines repeating at every nth line that contain info such as date report created, cycle id, job id, transaction id, etc.

i have an existing code that deletes these lines. i wanted to see if snb's codes will make it faster.

first i tested them as is. code execution times were the same.

when i expanded the row number to 100.000 i threw rte 1004.


thanks to all.

[snb]

You might test the autofilter suggestion as well. But you don't need the evaluate function if you can filter on 'date report'


Sub M_snb()
With Range("AA1:AA1000")
.AutoFilter 1, "Date report"
.Offset(1).SpecialCells(12).EntireRow.delete
.AutoFilter
End With
End Sub

But this might give the same result:


Sub M_snb()
sn=filter(split(createobject("scripting.filesystemobject").opentextfile("G:\OF\example.txt").readall,vbcrlf),"Date report",false)
sheets(1).cells(1).resize(ubound(sn)+1)=application.transpose(sn)
End Sub

[mancubus]

thanks snb.

and sorry LeeRoy. :)

[GTO]

And it's been a long time since some of us on the spear side were boys :cry2:

How cool! That is an expression I had not heard before.

And I agree. When I was little, I still remember my Grandma relaying that life would seem to speed up all-to-soon upon becoming an adult. I couldn't imagine it of course when each day seemed like an adventure of some type. Well, hopefully we keep a bit of the 'boy' in us :-) I remember your pointing out a link to a video of some folks having a contest of radio-controlled lighter-than-air miniature 'blimps' controlled and propelled by flapping wings and such. What a hoot! Nowadays when I just want to escape for a minute, I have this tiny helicopter that flies inside (or outside if there is absolutely no air movement). Fifty-three and I have this stupid grin on my face whenever I play with it. I "snuck" it in when at my mother's (76) and surprised her by flying it (slowly mind you) into the living room where she was watching TV. Just as big a grin and laughter.

[GTO]

Hi LeeRoy,

Sorry, we seem to be murdering your thread a bit. Here might be close to what you are trying to do, as I think you are wanting to pick out where it starts and stops.

In a Standard Module:

Option Explicit

Public frmSelect As frmAltSelect

Sub exampleRun()

Set frmSelect = New frmAltSelect
frmSelect.Show vbModal

End Sub

Public Function Advise()
MsgBox "You must have a Worksheet selected to run this code", vbInformation, vbNullString
End Function


In the Form's Module:

Option Explicit

Private bYikes As Boolean

Private Sub cmdReset_Click()

Me.lstEnd.List = Array(vbNullString)
DoEvents
Me.lstEnd.Clear

Me.lstStart.Enabled = True
Me.lstStart.ListIndex = 0

Me.lstEnd.Enabled = False

End Sub

Private Sub cmdSelect_Click()
Dim StartRow As Long
Dim EndRow As Long
Dim rngSelect As Range
Dim n As Long
Dim sAddress As String

If Me.lstStart.ListIndex > -1 _
And Me.lstEnd.ListIndex > -1 Then

Set rngSelect = Rows(CLng(Me.lstStart.Value))

For n = CLng(Me.lstStart.Value) To CLng(Me.lstEnd.Value) Step CLng(Me.lstSkip.Value) + 1
If Len(sAddress) < 240 Then
sAddress = sAddress & CStr(n) & ":" & CStr(n) & ","
Else
Set rngSelect = Application.Union(rngSelect, Range(Left$(sAddress, Len(sAddress) - 1)))
sAddress = vbNullString
End If
Next

Set rngSelect = Application.Union(rngSelect, Range(Left$(sAddress, Len(sAddress) - 1)))

rngSelect.Select

Unload Me

End If
End Sub

Private Sub lstStart_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim n As Long
Dim arrNumbers() As Long

If Not Me.lstStart.ListIndex = -1 Then

Me.lstStart.Enabled = False

ReDim arrNumbers(Me.lstStart.ListIndex + 3 To ActiveSheet.Rows.Count)
For n = Me.lstStart.ListIndex + 3 To ActiveSheet.Rows.Count
arrNumbers(n) = n
Next

Me.lstEnd.List = arrNumbers
Me.lstEnd.Enabled = True

End If

End Sub

Private Sub UserForm_Activate()
If bYikes Then Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim n As Long
Dim arrNumbers() As Long

If TypeName(ActiveSheet) = "Worksheet" Then

ReDim arrNumbers(1 To ActiveSheet.Rows.Count - 2)
For n = 1 To ActiveSheet.Rows.Count - 2
arrNumbers(n) = n
Next

With Me.lstStart
.ColumnCount = 1
.ColumnWidths = "67.95 pt"
.List = arrNumbers
.ListIndex = 0
End With

With Me.lstEnd
.ColumnCount = 1
.ColumnWidths = "67.95 pt"
.Enabled = False
End With

With Me.lstSkip
.List = Array(1, 2, 3)
.ColumnCount = 1
.ColumnWidths = "67.95 pt"
.ListIndex = 0
.SetFocus
End With

Else
bYikes = True
End If

End Sub

Private Sub UserForm_Terminate()
Set frmSelect = Nothing
If bYikes Then Application.OnTime Now + TimeSerial(0, 0, 1), "Advise"
End Sub

See the attached and please note, I would not suggest you actually use listboxes to list the rows. Probably a couple of textboxes controlled to only allow numbers and a check (maybe OnExit) that the value in the second one is higher than the first.

Hope that helps,

Mark

[GTO]

ACK!

Not tested, but change this part. Elsewise I think the possibility exists of an error if things happened just right, and I was skipping a row number whenever the string got long enough to re-Set the Range.

Private Sub cmdSelect_Click()
Dim StartRow As Long
Dim EndRow As Long
Dim rngSelect As Range
Dim n As Long
Dim sAddress As String

If Me.lstStart.ListIndex > -1 _
And Me.lstEnd.ListIndex > -1 Then

Set rngSelect = Rows(CLng(Me.lstStart.Value))

For n = CLng(Me.lstStart.Value) To CLng(Me.lstEnd.Value) Step CLng(Me.lstSkip.Value) + 1
If Len(sAddress) < 240 Then
sAddress = sAddress & CStr(n) & ":" & CStr(n) & ","
Else
'Debug.Print Left$(sAddress, Len(sAddress) - 1)
Set rngSelect = Application.Union(rngSelect, Range(Left$(sAddress, Len(sAddress) - 1)))
sAddress = vbNullString
'***EDIT 2***
sAddress = sAddress & CStr(n) & ":" & CStr(n) & ","
End If
Next

'***EDIT***
If Len(sAddress) > 0 Then
'Debug.Print Left$(sAddress, Len(sAddress) - 1)
Set rngSelect = Application.Union(rngSelect, Range(Left$(sAddress, Len(sAddress) - 1)))
End If

rngSelect.Select

Unload Me

End If
End Sub

[Bob Phillips]

Nowadays when I just want to escape for a minute, I have this tiny helicopter that flies inside (or outside if there is absolutely no air movement). Fifty-three and I have this stupid grin on my face whenever I play with it. I "snuck" it in when at my mother's (76) and surprised her by flying it (slowly mind you) into the living room where she was watching TV. Just as big a grin and laughter.

I would like one of those myself!

[GTO]

@xld:

Hi Bob,

I bought mine at what we refer to as a kiosk I guess. Basically a way too high priced little stand in a mega-mall. No regrets, I rarely succumb to spontaneous purchases, was just in the mood. Anyways, I emailed someone I know for a site that sells/ships at a far more reasonable price. I'll let you know.

Mark