Remove some intermediate lines

[Luciano Paulino da Silva]

Dear all,
I have worksheets with columns containg more than 50000 numbers. Do
you have any idea about a macro in order to remove some intermediate
lines (1, 2, 3, 4, 5, 6, 7, 8,...) of an Excel Worksheet keeping the
values between them like the following:
Data
999.771 4
999.792 5
999.812 5
999.833 5
999.853 5
999.873 5
999.894 5
999.914 5
999.935 4
999.955 3
999.976 3
999.996 3
1000.016 3

Result removing 1 line:
999.771 4
999.812 5
999.853 5
999.894 5
999.935 4
999.976 3
1000.016 3

Result removing 2 lines:
999.771 4
999.833 5
999.894 5
999.955 3
1000.016 3

Result removing 3 lines:
999.771 4
999.833 5
999.914 5
999.996 3

Result removing 4 lines:
999.771 4
999.873 5
999.976 3

Thanks in advance,
Luciano

 

[Mike H]

Hi,

I wouldn't 'remove' the lines I'd copy the edited data elsewhere like this.

Change SrcSheet to the sheet containing data
DestSheet to where the data is to go
MyStep to the required step

Sub Mariner()
Dim DstSheet As String
Dim SrcSheet As String
Dim LastRow As Long, MyStep As Long
Dim CopyRange As Range
SrcSheet = "Sheet3" 'Change to suit
DstSheet = "Sheet2" 'change to suit
MyStep = 2 'Change to suit
LastRow = Sheets(SrcSheet).Cells(Cells.Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow Step MyStep
If CopyRange Is Nothing Then
Set CopyRange = Sheets(SrcSheet).Rows(x).EntireRow
Else
Set CopyRange = Union(CopyRange, Sheets(SrcSheet).Rows(x).EntireRow)
End If
Next

CopyRange.Copy
Sheets(DstSheet).Range("a2").PasteSpecial
End Sub


Mike

 

[Tim Williams]

Do you mean you want to sample every n-th number in order to reduce your
dataset size ?

Tim

 

[Luciano Paulino da Silva]

Hi,

I wouldn't 'remove' the lines I'd copy the edited data elsewhere like this.

Change SrcSheet to the sheet containing data
DestSheet to where the data is to go
MyStep to the required step

Sub Mariner()
Dim DstSheet As String
Dim SrcSheet As String
Dim LastRow As Long, MyStep As Long
Dim CopyRange As Range
SrcSheet = "Sheet3" 'Change to suit
DstSheet = "Sheet2" 'change to suit
MyStep = 2 'Change to suit
LastRow = Sheets(SrcSheet).Cells(Cells.Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow Step MyStep
    If CopyRange Is Nothing Then
        Set CopyRange = Sheets(SrcSheet).Rows(x).EntireRow
    Else
        Set CopyRange = Union(CopyRange, Sheets(SrcSheet).Rows(x).EntireRow)
    End If
Next

CopyRange.Copy
Sheets(DstSheet).Range("a2").PasteSpecial
End Sub

Mike

Dear Mike,
Thank you for your response. The macro is working properly. However,
it is very slow to shetts containing more than 50000 lines. After 20
min the excel sttoped working and I'm using an workstation with two
XEON processors.
Have you any idea about what could we do?
Luciano

 

[Luciano Paulino da Silva]

Do you mean you want to sample every n-th number in order to reduce your
dataset size ?

Tim

Yes, exactly.

 

[Rick Rothstein]

Give this code a try, just set the 3 Const (constant) statements to match
your actual sheet layout)...

Sub ThinTheData()
Dim X As Long, LastRow As Long
Const NumberOfRowsToRemove As Long = 3
Const SheetName As String = "Sheet1"
Const DataColumn As Long = 1
With Worksheets(SheetName)
LastRow = .Cells(.Rows.Count, DataColumn).End(xlUp).Row
For X = 1 + LastRow - (LastRow Mod (NumberOfRowsToRemove + 1)) _
To 1 Step -(NumberOfRowsToRemove + 1)
.Cells(X + 1, "A").Resize(NumberOfRowsToRemove).EntireRow.Delete
Next
End With
End Sub

Note: This code assumes your data start on Row 1.

 

[Rick Rothstein]

And here is the version that allows your data to start on a different row
than Row 1...

Sub ThinTheData()
Dim X As Long, LastRow As Long
Const NumberOfRowsToRemove As Long = 4
Const SheetName As String = "Sheet5"
Const DataStartRow As Long = 4
Const DataColumn As Long = 1
With Worksheets(SheetName)
LastRow = .Cells(.Rows.Count, DataColumn).End(xlUp).Row
For X = DataStartRow + LastRow - (LastRow Mod (NumberOfRowsToRemove _
+ 1)) To 1 Step -(NumberOfRowsToRemove + 1)
.Cells(X + 1, "A").Resize(NumberOfRowsToRemove).EntireRow.Delete
Next
End With
End Sub

 

[Luciano Paulino da Silva]

And here is the version that allows your data to start on a different row
than Row 1...

Sub ThinTheData()
  Dim X As Long, LastRow As Long
  Const NumberOfRowsToRemove As Long = 4
  Const SheetName As String = "Sheet5"
  Const DataStartRow As Long = 4
  Const DataColumn As Long = 1
  With Worksheets(SheetName)
    LastRow = .Cells(.Rows.Count, DataColumn).End(xlUp).Row
    For X = DataStartRow + LastRow - (LastRow Mod (NumberOfRowsToRemove _
                            + 1)) To 1 Step -(NumberOfRowsToRemove + 1)
      .Cells(X + 1, "A").Resize(NumberOfRowsToRemove).EntireRow.Delete
    Next
  End With
End Sub

Thank you Rick!
The code is perfect for us.
Luciano

 

[Luciano Paulino da Silva]

And here is the version that allows your data to start on a different row
than Row 1...

Sub ThinTheData()
  Dim X As Long, LastRow As Long
  Const NumberOfRowsToRemove As Long = 4
  Const SheetName As String = "Sheet5"
  Const DataStartRow As Long = 4
  Const DataColumn As Long = 1
  With Worksheets(SheetName)
    LastRow = .Cells(.Rows.Count, DataColumn).End(xlUp).Row
    For X = DataStartRow + LastRow - (LastRow Mod (NumberOfRowsToRemove _
                            + 1)) To 1 Step -(NumberOfRowsToRemove + 1)
      .Cells(X + 1, "A").Resize(NumberOfRowsToRemove).EntireRow.Delete
    Next
  End With
End Sub

Thank you Rick!
The code is perfect for us.
Luciano