Dear all,

Someone has designed a macro for me which should perform a linea
extrapolation on gaps in my dataset.

However, it appears to work across the rows as opposed to down th
columns. I require it to work on columns F-I and R-U (inclusive) a
opposed to the whole dataset.

Would anybody be able to correct the macro below to achieve this?


Sub Pfil()

Dim i As Long
Dim r As Long
Dim er As Long
Dim sc As Long
Dim ec As Long
Dim src As Range
Dim dest As Range

'Start Row
r = 2
'Last row
er = Range("a65536").End(xlUp).Row - 1
'Start column (G) = first column + 1
sc = 7
'End column (L) = last column - 1
ec = 12

'Do all rows of data
For i = 1 To er

'If first Col is blank, fill
If Cells(r, sc - 1) = "" Then
Set src = Range(Cells(r, sc), Cells(r, ec))
Set dest = Range(Cells(r, sc - 1), Cells(r, ec))
src.AutoFill Destination:=dest, Type:=xlFillSeries
End If
'If last Col is blank, fill
If Cells(r, ec + 1) = "" Then
Set src = Range(Cells(r, sc), Cells(r, ec))
Set dest = Range(Cells(r, sc), Cells(r, ec + 1))
src.AutoFill Destination:=dest, Type:=xlFillSeries
End If
r = r + 1
Next i

End Sub


I hope someone is able to tackle this for me!

Many thanks for your help,
Steve

--
smurray44
-----------------------------------------------------------------------
smurray444's Profile: http://www.excelforum.com/member.php...fo&userid=2895
View this thread: http://www.excelforum.com/showthread.php?threadid=50670

Steve,

Did you try my macro?

Assuming that your step in the Time dimension is always consistent, your data is sorted based on the
identifier (station 1, etc.), and that your identifier is in column A - try the macro below, on a
copy of your data.

HTH,
Bernie
MS Excel MVP

Sub FillInBlanks()
Dim myCell As Range
Dim i As Integer
Dim myRange As Range

Set myRange = Range("A:A")

For i = 6 To 13

' Interpolation First
For Each myCell In Columns(i).SpecialCells(xlCellTypeBlanks)
With myRange
If (.Cells(myCell.Row).Value = _
.Cells(myCell.End(xlUp).Row).Value) And _
(.Cells(myCell.Row).Value = _
.Cells(myCell.End(xlDown).Row).Value) Then
myCell.Value = myCell.End(xlDown).Value + _
(myCell.Row - myCell.End(xlDown).Row) _
* (myCell.End(xlUp).Value - myCell.End(xlDown).Value) / _
(myCell.End(xlUp).Row - myCell.End(xlDown).Row)
End If
End With
Next myCell

'Now Extrapolation
For Each myCell In Columns(i).SpecialCells(xlCellTypeBlanks)
'Interpolate if a cell above has been filled in
With myRange
If (.Cells(myCell.Row).Value = _
.Cells(myCell.End(xlUp).Row).Value) And _
(.Cells(myCell.Row).Value = _
.Cells(myCell.End(xlDown).Row).Value) Then
myCell.Value = myCell.End(xlDown).Value + _
(myCell.Row - myCell.End(xlDown).Row) _
* (myCell.End(xlUp).Value - myCell.End(xlDown).Value) / _
(myCell.End(xlUp).Row - myCell.End(xlDown).Row)
ElseIf (.Cells(myCell.Row).Value < _
.Cells(myCell.End(xlUp).Row).Value) Then
myCell.Value = myCell.End(xlDown).Value + _
(myCell.Row - myCell.End(xlDown).Row) _
* (myCell.End(xlDown)(2).Value - myCell.End(xlDown).Value) / _
(myCell.End(xlDown)(2).Row - myCell.End(xlDown).Row)
Else
myCell.Value = myCell.End(xlUp).Value + _
(myCell.Row - myCell.End(xlUp).Row) _
* (myCell.End(xlUp)(0).Value - myCell.End(xlUp).Value) / _
(myCell.End(xlUp)(0).Row - myCell.End(xlUp).Row)
End If
End With
Next myCell

Next i

End Sub

"smurray444" wrote in message
...

Dear all,

Someone has designed a macro for me which should perform a linear
extrapolation on gaps in my dataset.

However, it appears to work across the rows as opposed to down the
columns. I require it to work on columns F-I and R-U (inclusive) as
opposed to the whole dataset.

Would anybody be able to correct the macro below to achieve this?


Sub Pfil()

Dim i As Long
Dim r As Long
Dim er As Long
Dim sc As Long
Dim ec As Long
Dim src As Range
Dim dest As Range

'Start Row
r = 2
'Last row
er = Range("a65536").End(xlUp).Row - 1
'Start column (G) = first column + 1
sc = 7
'End column (L) = last column - 1
ec = 12

'Do all rows of data
For i = 1 To er

'If first Col is blank, fill
If Cells(r, sc - 1) = "" Then
Set src = Range(Cells(r, sc), Cells(r, ec))
Set dest = Range(Cells(r, sc - 1), Cells(r, ec))
src.AutoFill Destination:=dest, Type:=xlFillSeries
End If
'If last Col is blank, fill
If Cells(r, ec + 1) = "" Then
Set src = Range(Cells(r, sc), Cells(r, ec))
Set dest = Range(Cells(r, sc), Cells(r, ec + 1))
src.AutoFill Destination:=dest, Type:=xlFillSeries
End If
r = r + 1
Next i

End Sub


I hope someone is able to tackle this for me!

Many thanks for your help,
Steve M


--
smurray444
------------------------------------------------------------------------
smurray444's Profile: http://www.excelforum.com/member.php...o&userid=28956
View this thread: http://www.excelforum.com/showthread...hreadid=506707