Kyle,
More meaningfully you should select the appropriate number of reduced
points, regardless of a changing number of original ones. This, in a
comfortable way, can be achieved by the following macro. You are free to add
mandatory prefices to variable names.
Option Explicit
Sub DataReduction()
'Petr Bezucha, 2008
'Subroutine reduces the count of xy data points to a set number
'and places the new range into the set position.
'Prerequisition is that the variables x and y
'should occupy the neighboring columns
Static PtsCount As Long
Dim DataCount As Long, DataStep As Long, S As Range, _
XO As Range, XR As Range, Inp As String, _
CO As Long, CR As Long, RO As Long, RR As Long, RM As Long
Const Title As String = "Data reduction"
'starting proposal
If PtsCount = 0 Then PtsCount = 50
'dispatching inputs
Set S = ActiveCell
On Error GoTo ErrExit
'cell selections are necessary
Set XO = Application.InputBox _
("Select the upmost X-original cell", _
Title, S.Address, , , , , 8)
Set XR = Application.InputBox _
("Select the upmost X-reduced cell", _
Title, S.Offset(, 2).Address, , , , , 8)
On Error GoTo 0
CO = XO.Column
CR = XR.Column
Inp = CStr(PtsCount)
Inp = Application.InputBox("Number of reduced points", _
Title, Inp, , , , , 1)
PtsCount = CLng(Inp)
Application.ScreenUpdating = False
RO = XO.Row
RR = XR.Row
DataCount = XO.End(xlDown).Row - RO + 1
DataStep = DataCount \ PtsCount
RM = XO.End(xlDown).Row - DataStep
Do While RO < RM
Cells(RO, CO).Copy Destination:=Cells(RR, CR)
Cells(RO, CO + 1).Copy Destination:=Cells(RR, CR + 1)
RO = RO + DataStep
RR = RR + 1
Loop
Application.ScreenUpdating = True
ErrExit:
End Sub
