[Dave Peterson[_3_]]

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

[daved]

Thanks for your help. The routine works like a charm.
Cheers.
-----Original Message-----
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

.