Populating a table based on a specific set of intervals and structure

[Alexgreggio]

Hello,

I need some help with populating a table in a specific way. My input will be an array composed of Hole ID (Name of drill hole), the depth of each drill hole and then the depth of the sensors installed along that drill hole in meters, like in the example here below.

I will then have a cell called "Length of sensor" which is a number that expresses the vertical length of the sensor in meters. I can change that number as I wish. See example here below

I want now to write a table that has a specific structure because it needs to feed into another software. I must cover the total depth of the hole starting from 0 meters but subdividing the intervals according to the presence of the sensors or the lack thereof. 

The depth of the sensor in table 1 is the center of the sensor and the length is equally divided in two intervals above and below the sensor. So the first interval will go from 0 to 2m above the first sensor (because in this case the length of the sensor is 4m). Then the second interval will be the first sensor which goes from 2m above the first sensor to 2m below it. Then the third interval will go from 2m below the first sensor to 2m above the second sensor and so on. Please note I want to also write the name of the drill hole that pertains to the relevant drill hole along all the intervals. I also want to write "Sensor x" next to the interval where the sensor is. Please note that sometimes the last sensor is at the bottom of the hole (like in the first drill hole), sometimes the drill hole continues down to the end of it without sensors.  

Here below is an example of the table I want to write based on these three drill holes and the depths and length of the sensors provided:

Can anybody help with how to get to this table? It would be greatly appreciated!

Thank you

[#2 · Accepted solution]

@Alexgreggio 

A macro solution:

Sub CreateList()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim r As Long
    Dim m As Long
    Dim c As Long
    Dim n As Long
    Dim l As Double
    Dim t As Long
    Dim h As String
    Dim d As Double
    Dim s As Double
    Dim x As Double
    Application.ScreenUpdating = False
    Set ws = ActiveSheet
    m = ws.Cells(1, 1).End(xlDown).Row
    n = ws.Cells(1, 1).End(xlToRight).Column
    l = ws.Cells(2, 8).Value / 2
    Set wt = Worksheets.Add(After:=ws)
    For r = 2 To m
        h = ws.Cells(r, 1).Value
        d = ws.Cells(r, 2).Value
        x = 0
        c = 3
        Do While ws.Cells(r, c).Value <> ""
            s = ws.Cells(r, c).Value
            t = t + 1
            wt.Cells(t, 1).Value = h
            wt.Cells(t, 2).Value = x
            wt.Cells(t, 3).Value = s - l
            t = t + 1
            wt.Cells(t, 1).Value = h
            wt.Cells(t, 2).Value = s - l
            wt.Cells(t, 3).Value = s + l
            wt.Cells(t, 4).Value = ws.Cells(1, c).Value
            x = s + l
            c = c + 1
        Loop
        If d > x Then
            t = t + 1
            wt.Cells(t, 1).Value = h
            wt.Cells(t, 2).Value = x
            wt.Cells(t, 3).Value = d
        End If
    Next r
    Application.ScreenUpdating = True
End Sub

[#3]

Thank you Hans!!
I have tried it and it works like a charm! I might a few questions as I play along with it but at the moment it does exactly what I wanted! Thank you so much!!