The How-To Geek Forums Have Migrated to Discourse

How-To Geek Forums / Microsoft Office

(Solved) - Removing rows and recalculating depth intervals in Excel 2010

(51 posts)
  • Started 4 years ago by Eligeol
  • Latest reply from Eligeol
  • Topic Viewed 3983 times

Posts: 31

Hi All,
I have a challenge which I hope someone can help me with. I have a bunch of data from holes drilled into the earth and I need to remove certain layers and recalculate or “bump up” the layers below. E.g.:
0 2.7 No Core
2.7 4.07 Dolerite Fine
4.07 6.96 Sandstone Fine
6.96 7.9 Sandstone Medium
7.9 13.38 Dolerite Fine
13.38 15.68 Sandstone Fine
15.68 15.76 Conglomerate
15.76 18.9 Sandstone Medium
18.9 24.42 Sandstone Fine
24.42 25.57 Sandstone Medium
25.57 27.4 Siltstone
27.4 28.43 Dolerite Fine
28.43 30 Siltstone
30 46.26 Shale (Light)
46.26 50 Dolerite Fine
50 57.78 Dolerite Medium
57.78 60.88 Dolerite Fine
60.88 65.28 Shale (Dark)

I need to remove all the layers called "Dolerite" (Fine, Medium & Coarse etc) and move each of the other layers up by whatever the thickness of the Dolerite layer is to get this:
0 2.7 No Core
2.7 5.59 Sandstone Fine
5.59 6.53 Sandstone Medium
6.53 8.83 Sandstone Fine
8.83 8.91 Conglomerate
8.91 12.05 Sandstone Medium
12.05 17.57 Sandstone Fine
17.57 18.72 Sandstone Medium
18.72 20.55 Siltstone
20.55 22.12 Siltstone
22.12 38.38 Shale (Light)
38.38 42.78 Shale (Dark)

Is there some sort of formula that I can use or way of doing this besides the very tedious manual way I have been using so far? There are about 300 of these to do!
Please help!?

Posted 4 years ago
Posts: 842

You'll need to explain the relationship between dolerite and what you take off the remaining entries. This is what I get...

how do you calculate 1.37, 6.65, 7.88 and 22.5 removed.

Also, is this a one time exercise or are you going to need to do similar things with different entries.

Posted 4 years ago
Posts: 31

Hi moreeg,

Thanks for the reply!
Ok - basically what I am trying to do is to remove the Dolerite (which is an igneous intrusion that has "disrupted" the sedimentary layers and therefore changed the original depths that each of these layers originally occurred at). Rock layers are continuous (ie. there are no gaps between these layer beneath our feet) so if I remove the Dolerite layers then I need to shift all the other layers up by the thickness of the Dolerite I have removed.
Also - because Dolerite only occurs in some of my study area and not in others it is a bit of a nuisance and I cant compare layers across the area of interest. Could you possibly elaborate on what formula you used to get Columns D to H?

To answer your second question - yes I would possibly like to remove other layers (which ones will depend on what I get from this initial excercise).

Thanks again - I knew there would be an expert out there who would know how this could be done :) I appreciate your help.

Posted 4 years ago
Posts: 566


Those numbers are the thicknesses of the Dolerite layers. He is removing those thicknesses from the sample.

Posted 4 years ago
Posts: 566

I have created a routine that will loop through your data and generate a report, to the right of your data (Columns E,F & G) that lists your sedimentary layers, removing the Dolerite layers and shifting the other layers accordingly.

First, open the worksheet containing your information (so you can save the macro code in that worksheet)

1. Create a macro and give it a name (I used Analyze) and a ctrl-letter key combination (I used ctrl-a, for Analyze)
2. Select cell A1 by clicking in it (to give the macro a line of code)
3. Stop the macro recording.
4. Edit the macro (Tools->Macro->(Click macro name)->Edit
5. Delete the line that says: Range("A1").Select
6. Paste the following code into the same line:

' Analysis Macro
' Macro recorded by Enthusiast
' Keyboard Shortcut: Ctrl+a
' This macro generates a report of sediment layers and thicknesses 4 columns
' to the right of the information. To rerun report, delete the report columns
' then re-execute macro
Dim Firstrow As Long 'First row of data
Dim Lastrow As Long ' Last row of data
Dim Lrow As Long ' Current row we are processing
Dim CalcMode As Long ' Save calculation state here
Dim ViewMode As Long ' Save view state here

Dim strDescription As String ' Current description

Dim strLayerTypeColumn As String ' Column Layer Type is in
Dim strLayerBeginColumn As String ' Column Layer Begin is in
Dim strLayerEndColumn As String ' Column Layer End is in
Dim strRptLayerTypeColumn As String ' Column Layer Type is in
Dim strRptLayerBeginColumn As String ' Column Layer Begin is in
Dim strRptLayerEndColumn As String ' Column Layer End is in

Dim dblDelta As Double ' Accumulated Difference (Totals of Dolerite layer thicknesses)
Dim dblBegin As Double ' Temporary Beginning of Current Layer
Dim dblEnd As Double ' Temporary End of Current Layer

Dim rptRow As Integer ' report row for output

'Set column for LayerBegin
strLayerBeginColumn = "A"
strRptLayerBeginColumn = "E"

'Set column for LayerEnd
strLayerEndColumn = "B"
strRptLayerEndColumn = "F"

'Set column for LayerType
strLayerTypeColumn = "C"
strRptLayerTypeColumn = "G"

'Save state and turn off auto-calculate and screen updating, for speed
With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

'We use the ActiveSheet but you can replace this with
'Sheets("MySheet")if you want
With ActiveSheet

    'We select the sheet so we can change the window view

    'If you are in Page Break Preview Or Page Layout view go
    'back to normal view, we do this for speed
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView

    'Turn off Page Breaks, we do this for speed
    .DisplayPageBreaks = False

    'Set the first and last row to loop through,
    'Firstrow + 1 to allow for header row, remove "+1" if no header row
    Firstrow = .UsedRange.Cells(1).Row + 1
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

    'Set Output start row for the report, 2 lines below data reporting on
    ' Change 2 to whatever distance below data you want the report
    'rptRow = Lastrow + 2
    rptRow = 1

    'Initialize Delta
    dblDelta = 0

    'Print report header
    .Cells(rptRow, strRptLayerBeginColumn).Value = "Layer Begin"
    .Cells(rptRow, strRptLayerEndColumn).Value = "Layer End"
    .Cells(rptRow, strRptLayerTypeColumn).Value = "Layer Type"

    'Increment report row
    rptRow = rptRow + 1

    'We loop from Firstrow to Lastrow (top to bottom)
    For Lrow = Firstrow To Lastrow Step 1

        'Set Descriptions to initial values
        strDescription = .Cells(Lrow, strLayerTypeColumn).Value

        'Begin Layer values are in column strLayerBeginColumn
        If Not IsError(.Cells(Lrow, strLayerBeginColumn).Value) Then
            dblBegin = .Cells(Lrow, strLayerBeginColumn).Value
            dblBegin = Val(.Cells(Lrow, strLayerBeginColumn).Value)
        End If

        'End Layer values are in column strLayerEndColumn
        If Not IsError(.Cells(Lrow, strLayerEndColumn).Value) Then
            dblEnd = .Cells(Lrow, strLayerEndColumn).Value
            dblEnd = Val(.Cells(Lrow, strLayerEndColumn).Value)
        End If

        If InStr(strDescription, "Dolerite") > 0 Then

            ' Update Delta
            dblDelta = dblDelta + (dblEnd - dblBegin)


            'Print report line
            .Cells(rptRow, strRptLayerBeginColumn).Value = dblBegin - dblDelta
            .Cells(rptRow, strRptLayerEndColumn).Value = dblEnd - dblDelta
            .Cells(rptRow, strRptLayerTypeColumn).Value = strDescription

            'increment report line
            rptRow = rptRow + 1

        End If

    Next Lrow

    'Print final report line
    '.Cells(rptRow, strRptLayerBeginColumn).Value = dblBegin - dblDelta
    '.Cells(rptRow, strRptLayerEndColumn).Value = dblEnd - dblDelta
    '.Cells(rptRow, strRptLayerTypeColumn).Value = "Layer Type"

End With

'Return screen updates and auto-calculation to initial settings
ActiveWindow.View = ViewMode
With Application
    .ScreenUpdating = True
    .Calculation = CalcMode
End With

7. leave the Procedure name and the "End Sub" statements intact at the beginning and end.
8. Save the code (Clicking the upper-right X will save and close the Visual Basic editor).
9. Save your worksheet (IMPORTANT!) This way if something goes wrong you have not lost your data.
9. Back in your worksheet, hold ctrl-(whatever letter you chose for your macro) to generate the analysis.
10. If you need/want to rerun the macro, delete the columns to the right of your data and re-generate the analysis.

If you have any questions, please post back.

Posted 4 years ago
Posts: 842

Funny this should be about thickness. I kept reading the words and nothing was penetrating the thick skull. I finally got it when I went through your macro.

Posted 4 years ago
Posts: 566

LOL. I hope the OP returns :)

Posted 4 years ago
Posts: 842

I'm sure he will. It would be a shame if he didn't after the work you've put into this. How long did it take you to write the macro?

Posted 4 years ago
Posts: 566

I spent about an hour with it. It is fun :)

Posted 4 years ago
Posts: 842

I agree - it is fun but apparently much more fun for me because I figure that would have taken me 4-5 hours to complete (once I understood what the problem was which - it seems - would have taken some time too). I'm jealous.

Posted 4 years ago
Posts: 31

Wow! Thank you sooo much.
I havent used macro's in Excel before so this would be a very good introduction. Let me follow your steps and I'll post back later.

Thanks again - I really appreciate your time and effort on this!!!!

Posted 4 years ago
Posts: 31

Hi again Enthusiast,

I seem to be having a problem with a Run-time error '13' - Type Mismatch message. When I click on Debug - it highlights this line:

dblEnd = .Cells(Lrow, strLayerEndColumn).Value

I think it might be because one of my holes ends with dolerite? This is the section where the problem is:
97.49 100.58 Sandstone Medium 72.64 73.19 Coal
100.58 101.1 Sandstone Coal Lenses 73.19 73.74 Shale (Dark)
101.1 101.8 Shale Inclusions -31.84 -29.64 No Core
101.8 102.02 Sandstone Fine -29.64 -26.97 Siltstone
102.02 102.4 Conglomerate -26.97 -9.81 Siltstone
102.4 102.95 Coal -9.81 -7.94 Sandstone Fine
102.95 103.5 Shale (Dark) -138.32 -134.75 No Core
103.5 105.58 Dolerite -134.75 -133.87 Sandstone Fine
0 2.2 No Core -133.87 -127.47 Shale (Light)
2.2 30 Dolerite -127.47 -125.06 Shale (Light)
30 34.7 Dolerite -125.06 -113.11 Shale (Light)
34.7 41.83 Dolerite -113.11 -96.78 Sandstone Fine
41.83 44.5 Siltstone -96.78 -95.67 Sandstone Medium

Is there a way to modify the macro for this? What I have been doing manually (before your help with the macro) is to remove all dolerite including the ones where the hole ends in the dolerite.

Thanks again

Posted 4 years ago
Posts: 566

I based the code on the scenario presented. Your sample data started at zero and went up from there. Three columns, where the layer begins, where the layer ends and the description of the sediment type.

If this is not the case, the code will fail. The "Type Mismatch" error leads me to think one of your numerical values contains non-numerical characters or is in the wrong place. Post the sample data that the failure occurred on and I will take a look at it.

Posted 4 years ago
Posts: 566

The data you just presented is not in the same format as the original posting. You are now showing 6 columns, and some of the numbers are negative. Please explain this new format and I will see what I can do.

Posted 4 years ago
Posts: 31

Hi again,

Ok - this is totally my fault - I apologise profusely.
I copied just a selection of the data (to keep things simple). The database is large but it appears as below (just for the first hole) (Columns A to E):
Would it be possible for me to email you my Excel sheet - if that would make it simpler? There are just over 19000 lines in Excel so I cant post it here?

Bore Depth1 Depth2 Lithology Comment
AN001 0 0.14 No Core
AN001 0.14 3.73 SANDSTONE FINE Massive, lenses
AN001 13.15 14.98 SANDSTONE MEDIUM
AN001 14.98 15.98 SANDSTONE FINE
AN001 15.98 16.28 Coal Less than1% Bright
AN001 16.28 16.45 SANDSTONE MEDIUM
AN001 16.45 21.93 SANDSTONE FINE Massive
AN001 21.93 22.98 SANDSTONE MEDIUM
AN001 22.98 26.56 SANDSTONE FINE Shaly lenses
AN001 26.56 27.94 SHALE/SANDSTONE cs lenses
AN001 27.94 33.78 SANDSTONE FINE Massive,lenses
AN001 33.78 33.88 Coal Dull
AN001 33.88 33.94 SHALE (DARK)
AN001 33.94 36.25 Seam AN001A
AN001 36.25 36.85 SHALE (DARK)
AN001 36.85 37.3 Seam AN001B
AN001 37.3 37.51 SHALE (DARK)
AN001 37.51 37.58 Carbonaceous Shale
AN001 37.58 39.04 SHALE (DARK)
AN001 39.04 42.09 SANDSTONE FINE Laminated
AN001 42.09 42.29 SHALE (DARK)
AN001 42.29 46.87 SANDSTONE FINE Laminated,interlaminated
AN001 46.87 47.05 SHALE/SANDSTONE Shaly incl.cs lenses
AN001 47.05 52.93 SANDSTONE FINE Laminated,lenses
AN001 52.93 53 SHALE/SANDSTONE sd in shale
AN001 53 53.45 SANDSTONE FINE Interlaminated
AN001 53.45 54.66 SHALE (DARK)
AN001 54.39 54.66 SHALE (DARK) Silty
AN001 56.03 56.26 SHALE (DARK)
AN001 56.26 56.35 Carbonaceous Shale Coaly bands
AN001 56.35 61.09 SHALE (DARK) Silty
AN001 61.09 64.41 SANDSTONE FINE Laminated,lenses
AN001 64.41 66.32 SANDSTONE MEDIUM Laminated
AN001 66.32 66.84 SANDSTONE FINE Laminated,x-bedded
AN001 66.84 67.17 SANDSTONE MEDIUM
AN001 67.17 79.3 Shale Inclusions Laminated+massive,shaly incl.
AN001 79.3 81.95 SANDSTONE MEDIUM Laminated
AN001 81.95 82.07 SHALE (DARK)
AN001 82.07 83.17 SANDSTONE FINE Thickly laminated,lenses
AN001 83.17 84.09 SHALE (DARK)
AN001 84.09 84.49 Mudstone Greenish
AN001 84.49 85.11 SHALE (DARK)
AN001 85.11 85.99 SILTSTONE
AN001 85.99 86.13 Mudstone
AN001 86.13 86.68 SILTSTONE Laminated
AN001 86.68 89.32 SHALE (DARK)
AN001 89.32 90.13 Mudstone
AN001 90.13 92.09 SHALE/SILTSTONE Interlaminated,ripple x-laminated
AN001 92.09 94.62 SHALE (DARK) Silty
AN001 94.62 95.39 Mudstone
AN001 95.39 96.13 SHALE (DARK)
AN001 96.13 96.94 Mudstone Shaly
AN001 96.94 97.49 SHALE (DARK)
AN001 97.49 98.04 SILTSTONE Muddy
AN001 98.04 99.24 Mudstone Shaly
AN001 99.24 100.06 SILTSTONE Massive
AN001 100.06 100.6 SHALE (DARK)
AN001 100.6 101.67 Mudstone
AN001 101.67 103.02 SHALE (DARK)
AN001 103.02 105.28 SILTSTONE Sandy
AN001 105.28 107.51 SANDSTONE FINE Laminated
AN001 107.51 111.95 Dolerite Fine Intrusive with calcitic veins
AN001 111.95 115.96 SILTSTONE Ripple x-laminated
AN001 115.96 116.57 SHALE/SILTSTONE Interlaminated,speckles
AN001 116.57 116.87 SILTSTONE Laminated
AN001 116.87 117.67 Mudstone
AN001 117.67 118.61 SHALE (DARK)
AN001 118.61 120.03 Mudstone Shaly
AN001 120.03 120.86 SILTSTONE
AN001 120.86 123.12 SHALE (DARK)
AN001 123.12 123.85 SANDSTONE FINE Laminated,lenses
AN001 123.85 124.28 SHALE/SILTSTONE Interlaminated,lenses,speckles
AN001 124.28 132.17 Shale Inclusions Laminated,lenses,shaly incl.
AN001 132.17 132.44 SHALE (DARK)
AN001 132.44 132.71 SHALE/SILTSTONE Thinly laminated,ripple x-laminated
AN001 132.71 136.89 Shale Inclusions Shaly incl.
AN001 136.89 137.45 SHALE (DARK)
AN001 137.45 137.5 SANDSTONE FINE
AN001 137.5 137.97 SHALE/SANDSTONE Ripple x-laminated
AN001 137.97 138.99 SHALE (DARK) Ripple x-laminated
AN001 138.99 139.62 SANDSTONE FINE Interlaminated,banded
AN001 139.62 141.8 SHALE (DARK) Silty
AN001 141.8 143.25 SILTSTONE Shaly
AN001 143.25 146.29 Mudstone Reddish in parts
AN001 146.29 146.44 SHALE (DARK) Muddy
AN001 146.44 150.16 SANDSTONE FINE Massive
AN001 150.16 151.44 Mudstone Reddish in parts

It might be posisble that some of the cells are not registered by Excel as a number - should I select all the Depth1 & Depth2 cells and make them number cells instead of General cells?

Thanks again for your help!
I have used Excel for many years but on a fairly low level but as time goes on I'm amazed at what it can do especially coming from a generation where we had to teach ourselves. If I can ask one more question of you - where did you learn to write macros?


Posted 4 years ago
Posts: 566

I am looking into this latest information. Is this the standard format for your data? If so, I will modify the macro to work with the data as presented.

As for myself and macros, I am an old school programmer (self-taught). The code I generated is a VBA procedure with a macro front-end (it makes it easier for the end-user to access). If your search "excel macro tutorial" you should get more than your share of information regarding how to code macros.

Feel free to email me the worksheet, my email address is in my profile. Click the word "Member" under my name to the left of my posts.

Posted 4 years ago
Posts: 566

Can a moderator please make my email address available to Eligeol?

Thank you.

Posted 4 years ago
Posts: 10945

tis done

Posted 4 years ago
Posts: 566

I have updated the macro to handle the latest information. Waiting to hear if this is the standard format before posting it.

Posted 4 years ago
Posts: 842

Hi Vincent

It was fascinating going through your code. You went through a similar thought process that I went through - starting with calculating the delta of the layer thickness with the intention of recalculating when you hit an instance of Dolerite but then realizing that all that was needed was to use the next instance of beginning and ending layers, From there it was "only" a matter of varying the the reporting row and the input row which you did elegantly by skipping the reporting layer bump in your "if" statement.

But, that's where the similarity ends. As I said - it would have taken me 4 or 5 times longer to code this and the end result would not have been as comprehensive and elegant as yours. If you don't mind, could you post the revised code so I can see how you dealt with the additional columns?

Posted 4 years ago

Topic Closed

This topic has been closed to new replies.