I think I'd just loop through the rows and create the new data that way.
Option Explicit
Sub testme01()
Application.ScreenUpdating = False
Dim curWks As Worksheet
Dim oRow As Long
Dim inCtr As Double
Dim myInc As Double
Dim LowValue As Double
Dim HighValue As Double
Dim NewValue As Double
Dim res As Variant
myInc = 0.01
Set curWks = Worksheets("sheet1")
With curWks
.Range("d:e").ClearContents
.Range("d1").Resize(1, 2).Value = Array("Depth", "New_X")
.Range("d:e").NumberFormat = "0.00"
LowValue = .Range("A2").Value
HighValue = .Cells(.Rows.Count, "B").End(xlUp).Value
oRow = 2
For inCtr = LowValue To HighValue Step myInc
NewValue = inCtr
.Cells(oRow, "D").Value = NewValue
res = Application.VLookup(NewValue, _
curWks.Range("A2:c" & _
curWks.Cells(curWks.Rows.Count, "A").End(xlUp).Row), 3)
If IsError(res) Then
.Cells(oRow, "e").Value = "Shouldn't happen"
Else
.Cells(oRow, "E").Value = res
End If
oRow = oRow + 1
Next inCtr
End With
Application.ScreenUpdating = True
End Sub
daved wrote:
I have a data set where I have an depth interval top and
base and a measurement that fits across the interval. I
have an another column where list of data from the top to
the base in a fine increment. I now need to write the
measurement next to the appropriate depth point.
TOP BASE X DEPTH NEW_X
235.56 235.71 0.10 235.56 .10
235.71 235.74 0.21 235.57 .10
235.58 .10
235.59 .10
. .
. .
235.70 .10 'Base of first interval
235.71 .21 'Top of second
235.72 .21
Here is my code to write the DEPTH column where the data
goes from the minimum top to the maximum base incremented
at 0.01. I don't have a clue as how to migrate the X's to
the new column. Note that there could be 1000 TOP and
BASE PAIRS that convert to 10000 DEPTH cells.
Sub CoreFill()
Dim TopDepth As Double
Dim BotDepth As Double
Dim i As Integer
Dim DepthRange As Range
Dim NewDepth As Range
Dim n As Integer
Set DepthRange = Range("A2:B30002")
Set NewDepth = Range("F2:F30002")
TopDepth = Application.Min(DepthRange)
BotDepth = Application.Max(DepthRange)
'calculate top depth
Cells(1, 4) = "Top"
Cells(2, 4) = TopDepth
'calculate bottom depth
Cells(1, 5) = "Base"
Cells(2, 5) = BotDepth
'calculate # of cells required @ 100 samples/metre
n = (BotDepth - TopDepth) * 100
'initiate top depth
Cells(1, 6) = "New_Depth"
Cells(2, 6) = TopDepth
For i = 3 To n
Cells(i, 6) = Cells(i - 1, 6) + 0.01
If Cells(i, 6) = BotDepth Then
Exit Sub
End If
Next i
End Sub
Any help would be greatly appreciated, Thanks in advance.
--
Dave Peterson