SEARCH

The How-To Geek Forums Have Migrated to Discourse



Join the Discussion at discuss.howtogeek.com

How-To Geek Forums / Microsoft Office

Extracting selected rows from multiple columns

(40 posts)
  • Started 6 months ago by Eligeol
  • Latest reply from Eligeol
  • Topic Viewed 2400 times

1 2
Eligeol
Posts: 31

Hi again all,

My limited knowledge of Excel 2010 has once again left me in a corner and hopefully someone can show me the light so I can find my way out of the tunnel :)

I have a list (like in my post from earlier in the year - (Solved) - Removing rows and recalculating depth intervals in Excel 2010
) My thanks again to moreeg and Enthusiast for your help last time too!

What I now need to do with all this info is to seperate it out so I can focus on the Dolerite (intrusive igneous rock type).

e.g. - this is what I have (I have only included 5 boreholes for simplicity sake):

Bore Depth1 Depth2 Lithology
BH330 0 4.56 No Core
BH330 4.56 23.7 DOLERITE
BH330 23.7 30 SILTSTONE
BH330 30 43.2 SANDSTONE
BH330 43.2 63.18 DOLERITE
BH330 63.18 71.55 SHALE
BH330 71.55 74.1 SILTSTONE
BH330 74.1 88.11 SANDSTONE
BH330 88.11 88.35 SHALE
BH330 88.35 89.89 Seam
BH330 89.89 90.5 SHALE
BH330 90.5 100.38 SANDSTONE
BH330 100.38 101.4 SANDSTONE COAL LENSES
BH330 101.4 102.37 SANDSTONE
BH330 102.37 103.35 SANDSTONE COAL LENSES
BH331 0 4.3 No Core
BH331 4.3 27.66 DOLERITE
BH331 27.66 46.1 SHALE
BH331 46.1 46.36 COAL
BH331 46.36 56.25 SHALE
BH331 56.25 56.8 SANDSTONE
BH331 56.8 57.19 DOLERITE
BH331 57.19 57.41 SHALE
BH331 57.41 149.12 DOLERITE
BH331 149.12 160.4 SHALE
BH331 160.4 169 SANDSTONE
BH331 169 169.66 SHALE
BH331 169.66 174.73 SANDSTONE
BH331 174.73 176 Seam
BH331 176 178.6 SHALE
BH331 178.6 202.4 SANDSTONE
BH333 0 3.6 No Core
BH333 3.6 65.7 DOLERITE
BH333 65.7 79.54 SHALE
BH333 79.54 94.54 SANDSTONE
BH333 94.54 97.49 SHALE
BH333 97.49 100 SANDSTONE
BH333 100 117.68 SHALE
BH333 117.68 151.38 DOLERITE
BH336 0 3.4 No Core
BH336 3.4 40.36 DOLERITE
BH336 40.36 42.5 SHALE
BH336 42.5 43.2 CARBONACEOUS SHALE
BH336 43.2 48.67 SHALE
BH336 48.67 48.69 DOLERITE
BH336 48.69 48.79 SHALE
BH336 48.79 51.3 DOLERITE
BH336 51.3 52.27 SANDSTONE
BH336 52.27 73.65 DOLERITE
BH336 73.65 75.06 SHALE
BH336 75.06 76.3 SANDSTONE
BH336 76.3 78.6 SHALE
BH336 78.6 78.79 DOLERITE
BH336 78.79 79.32 SHALE
BH336 79.32 79.46 DOLERITE
BH336 79.46 79.8 SHALE
BH336 79.8 150.47 DOLERITE
BH336 150.47 176.86 SHALE
BH336 176.86 186.67 SANDSTONE
BH336 186.67 186.85 CONGLOMERATE
BH336 186.85 187.08 SANDSTONE
BH336 187.08 187.36 CONGLOMERATE
BH336 187.36 192.62 SHALE
BH336 192.62 200.82 SANDSTONE
BH336 200.82 201 SHALE INCLUSIONS
BH336 201 204.4 SANDSTONE
BH336 204.4 204.93 SANDSTONE COAL LENSES
BH336 204.93 205.1 SHALE
BH336 205.1 210.87 SANDSTONE
BH336 210.87 211.13 SHALE
BH336 211.13 220.4 SANDSTONE
BH337 0 0.57 No Core
BH337 0.57 6.36 SHALE
BH337 6.36 7 SANDSTONE
BH337 7 11.84 SHALE
BH337 11.84 66.16 DOLERITE
BH337 66.16 70 SHALE
BH337 70 73.48 SANDSTONE
BH337 73.48 75.89 SHALE
BH337 75.89 76.34 CARBONACEOUS SHALE
BH337 76.34 98.07 SHALE
BH337 98.07 106.27 SANDSTONE
BH337 106.27 106.79 CONGLOMERATE
BH337 106.79 109.47 SANDSTONE
BH337 109.47 110.8 Seam
BH337 110.8 115.1 SHALE
BH337 115.1 130.39 SANDSTONE

You will notice that there is some repetion of especially the Dolerite layers. What I would like to be able to do is to extract the Dolerite info (and possibly later also the other info for other layesr to focus on each layer in more detail) and generate something like this:

Bore Depth1 Depth2 Lithology Dol No Thickness Bore Depth1 Depth2 Lithology Dol No Thickness
BH330 4.56 23.7 DOLERITE D01 19.14 BH330 43.2 63.18 DOLERITE D02 19.98
BH331 4.3 27.66 DOLERITE D01 23.36 BH331 56.8 57.19 DOLERITE D02 0.39
etc...

At least this way I can focus on the thicknesses, depths, elevations etc. without the "clutter" of the other layers. And that way I can also start to correlate these Dolerite layers.

Can this be done??

I would appreciate any help or advice.

Thanks

Eligeol

Posted 6 months ago #
Top
 
Xhi
Xhi
Posts: 6298

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

Posted 6 months ago #
Top
 
moreeg
moreeg
Posts: 842

Hi Eligeol

Nice to see you back. It's pretty late here so I'm in no shape to work on a solution that would give you the results in the format you want but here's a cheap solution that will get you close. Make a copy of the sheet and then sort on lithology.

But hang on a while; Enthusiast may be working on the solution or I can get to it in the next day or so.

Posted 6 months ago #
Top
 
Eligeol
Posts: 31

Hi moreeg,

Thanks - as you can see I'm still working on this Dolerite issue (albeit between my other activities) :)
I have done just that - sorted the list according to Lithology then cut and paste but wow what a painstaking activity. I tried to search online for a way of extracting this type of info but without success. If you and/or Enthusiast can help I would appreciate it but if its a "mission" I understand and will just continue manually.
I was hoping that if it is possible to do this then, as I go through the other lithologies, I can do the same for each of them. Between you and me (and obviously anybody else reading this post) I am considering beginning a PhD on the Geology of this area. Since I'm already doing this much detailed work I might as well try to progress academically too :) I love science and would love to be able to add to it but have to ovecome these types of small hurdles along the way.

Anyway, if you guys can help I obviously would appreciate it.

Posted 6 months ago #
Top
 
Enthusiast
Enthusiast
Posts: 566

Hi there, Eligeol,

I have a question. Is it preferable for your output to remain horizontal (as you presented it) instead of vertical, as below?

Bore   Depth1 Depth2 Lithology Dol No Thickness
BH330  4.56   23.7   DOLERITE  D01    19.14
BH330  43.2   63.18  DOLERITE  D02    19.98

Bore   Depth1 Depth2 Lithology Dol No Thickness
BH331  4.3    27.66  DOLERITE  D01    23.36
BH331  56.8   57.19  DOLERITE  D02    0.39
etc...
Posted 6 months ago #
Top
 
moreeg
moreeg
Posts: 842

I'd have to agree with Enthusiast. In the sample data there are quite a few instances where there are more than 2 or 3 instances of a sample in a bore e.g.

SHALE  BH336	       11
SANDSTONE  BH336	8
DOLERITE  BH336	        7
SHALE  BH331	        6
SHALE  BH337	        6
SHALE  BH338	        6
SANDSTONE  BH337	5
SANDSTONE  BH338	5
SANDSTONE  BH330	4
SANDSTONE  BH331	4
DOLERITE  BH331	        3
SHALE  BH330	        3
SHALE  BH333	        3

having 3, 4, or more instances horizontally would be difficult to analyse.

Still working on how to do this. Enthusiast, are you close to an approach?

Posted 6 months ago #
Top
 
moreeg
moreeg
Posts: 842

Here's what I've come up with - i've taken many liberties with the stated requirements eg;

As indicated in the previous posts, I've set the results vertically instead of horizontally
I've changed the order of the results to start with Lith and then Bore since these are what you are keying on
The routine will analyse ALL Liths and Bores. We can work on selecting specific Liths if you really need it

This is what the output will look like

Here is the code - there are 3 macros - the main one and 2 to sort. There will probably be many questions and changes and some of my assumtions will undoubtedly be wrong, so, like the last time, patience will be a requirement and make sure that you make a copy of your file to test this.

Sub Analyse()
'
  Application.ScreenUpdating = False      'set to True for debugging/False to improve performance

 Run ("SortLithBore")

    NSamples = Range("A1").End(xlDown).Row     'number of samples

    Range("G2:AC" & NSamples).ClearContents   'Clear out the work columns

    Range("AA2").Select
        ActiveCell.FormulaR1C1 = "=RC[-23] & RC[-26]"    'create Bore/Lith combinations
        Selection.Copy
    Range("AA2:AA" & NSamples).Select
        ActiveSheet.Paste

    Range("AA2:AA" & NSamples).Select
        Selection.Copy

    Range("AB2").Select
        Selection.PasteSpecial Paste:=xlPasteValues

    Range("AB2:AB" & NSamples).Select
        Application.CutCopyMode = False
        ActiveSheet.Range("$AB$2:$AB$" & NSamples).RemoveDuplicates Columns:=1, Header:= _
        xlNo

    NTypes = Range("AB2").End(xlDown).Row  'The number of unique Bore/Lith combinations

    Range("AC2").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "=COUNTIF(R2C27:R104C27,RC[-1])" 'Calculates the number of occurrences of a Lith in any one bore
        Selection.Copy
    Range("AC2:AC" & NTypes).Select
        ActiveSheet.Paste

    Application.CutCopyMode = False

LkUpRange = "$AB$2:$AC$" & NTypes  'Is the range of occurrences of a lith in any one bore

'Sets Headers
    Range("G1") = "Lithology"
    Range("H1") = "Bore"
    Range("I1") = "Dol No"
    Range("J1") = "Depth1"
    Range("K1") = "Depth2"
    Range("L1") = "Thickness"

For i = 2 To NSamples
    LkUpVal = Cells(i, 4) & Cells(i, 1)

    N_Occ = Application.VLookup(LkUpVal, Range(LkUpRange), 2, False)

        For b = 1 To N_Occ
            If b = 1 Then                   'will only enter the Lith and Bore for the 1st occurrence
                Cells(i, 7) = Cells(i, 4)
                    Cells(i, 8) = Cells(i, 1)
            End If

            Cells(i, 9) = "D0" & b
            Cells(i, 10) = Cells(i, 2)
            Cells(i, 11) = Cells(i, 3)
            Cells(i, 12) = Cells(i, 3) - Cells(i, 2)

            If b < N_Occ Then
                i = i + 1
                    End If
        Next b
Next i

Run ("SortBoreDepth")

Application.ScreenUpdating = True      'set to True for debugging/False to improve performance

End Sub

Sub SortLithBore()

    NSamples = Range("A1").End(xlDown).Row     'number of samples

    Range("A1:D" & NSamples).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("D2:D" & NSamples) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A104") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:D" & NSamples)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("AO1:AO12").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("AO1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("AO1:AO12")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
End Sub
Sub SortBoreDepth()

    NSamples = Range("A1").End(xlDown).Row     'number of samples

    Range("A1:D" & NSamples).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A104") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2:B104") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:D" & NSamples)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

        Range("A1").Select

End Sub
Posted 6 months ago #
Top
 
Eligeol
Posts: 31

Hi,

Thanks!
As for the questions - I see your point - there are 2 holes that have 11 dolerite layers (let alone all the other layers).
What I am hoping for is some way to "split out" the Dolerite layers for each hole so that I can get:
a) Order of the Dolerite (to define D01, D02 etc.)
b) Depth from and to (to also calculate the thickness from this)

My next step would then be to link the surface elevation of the borehole minus the depth from (and to) to calculate the Top-of-Dolerite elevation and the Bottom-of-Dolerite evelation. This will help me to correlate the dolerite across my area.

A quick note on dolerite (I used to be a Geology lecturer in time gone by :)) Dolerite, being an intrusive (inside the earth) molten rock will migrate from deep within the earth upwards (under pressure) and exploit any small weakness within the earths crust where it will intrude/be forced into. This process is obviously very unpredictable especially in terms of where the dolerite will intrude. Sometimes it is nice and flat and then for whatever reason it will change angle (following the direction of the weakness in the rock) and intrude at a different elevation somewhere else. This makes for difficulty in correlation from one area to the next.

For this execise it would be useful to try to isolate just the dolerite (for now - then with time I will do the same for the other layers which should be a bit simpler). Many geological software packages happily handle layers that have an order (especially one that repeats over an area like the sandstones, shales etc. i.e. there is a bit of a pattern) but the random nature of Dolerite intrusion make the modelling very tricky and the software often cant handle it and will freeze up.

I hope this maybe clarifies my quandary? Again - my deepest thanks to you for all your help!

Posted 6 months ago #
Top
 
moreeg
moreeg
Posts: 842

Hi Eligeol

Ok, I thought I got the first part right (except that I'm extracting data for all layers and all holes). Can you look again at the report I generated and specifically at the Dolerite lines and tell me how you would want it differently. Note that where there are several layers of Dolerite in a hole I don't repeat the name and hole number - I thought this made it easier to read. Other than that I do have the DOL01, 02 , 03 etc where there are several layers in a hole as well as the depth of each dolerite layer. So I don't see what I'm missing unless I've misunderstood something (which has been known to happen ... often).

Posted 6 months ago #
Top
 
Eligeol
Posts: 31

Hi moreeg,

Ok - I see your point. And with the column format I can use "Sort" to work with the groups of Lithologies...hmmm. If you dont mind - I will go through this in detail tonight with my full data and report back tomorrow.

Thanks!

Posted 6 months ago #
Top
 
Eligeol
Posts: 31

Hi again moreeg,

I just tried to do the macro run now and when I run it - it gets to BH123 and stops (in Carbonaceous Shale). I have recorded the macro just as per Enthusiast's post: http://www.howtogeek.com/forum.....replies=51
except I didnt remove the line Range("A1").Select
Am I supposed to remove this (I did just to test but the same thing happens)?
Could you possibly briefly confirm the steps please?

Thanks

Posted 6 months ago #
Top
 
Enthusiast
Enthusiast
Posts: 566

Eligeol,

Explain this:

My next step would then be to link the surface elevation of the borehole minus the depth from (and to) to calculate the Top-of-Dolerite elevation and the Bottom-of-Dolerite evelation(sic). This will help me to correlate the dolerite across my area.

Where is "surface elevation" in your presented data? Once we have all the information you are working from and working toward, we may be able to modify the earlier process to generate your new report.

Posted 6 months ago #
Top
 
Eligeol
Posts: 31

Hi Enthusiast,

Can I perhaps email you the file (I think I still have it from the earlier post)?
Also could I possibly get moreeg's email please - then I can send the same file??

Posted 6 months ago #
Top
 
moreeg
moreeg
Posts: 842

Hi Eligeol
One of the mods can give you my email address. I'd be happy to get your file.

Posted 6 months ago #
Top
 
Enthusiast
Enthusiast
Posts: 566

Send away. You always present interesting scenarios :)

Posted 6 months ago #
Top
 
moreeg
moreeg
Posts: 842

@Eligeol
I found the bug that stops the routine from completing but please send the file anyways because, as Enthusiast points out, the second part of your question is unclear (yet intriguing).

@Enthusiast
your critique of the code is always welcome. I made several false starts on this one trying to use arrays but with no luck. I consider my code to be a bit brutish because of an over reliance of data preparation in the spreadsheet. I'm sure there are more elegant ways to do this.

Here is the debugged code for the main macro i.e. don't overwrite the sorting macros.

Sub Analyse()
'
  Application.ScreenUpdating = False      'set to True for debugging/False to improve performance

 Run ("SortLithBore")

    NSamples = Range("A1").End(xlDown).Row     'number of samples

    Range("G2:AC" & NSamples).ClearContents   'Clear out the work columns

    Range("AA2").Select
        ActiveCell.FormulaR1C1 = "=RC[-23] & RC[-26]"    'create Bore/Lith combinations
        Selection.Copy
    Range("AA2:AA" & NSamples).Select
        ActiveSheet.Paste

    Range("AA2:AA" & NSamples).Select
        Selection.Copy

    Range("AB2").Select
        Selection.PasteSpecial Paste:=xlPasteValues

    Range("AB2:AB" & NSamples).Select
        Application.CutCopyMode = False
        ActiveSheet.Range("$AB$2:$AB$" & NSamples).RemoveDuplicates Columns:=1, Header:= _
        xlNo

    NTypes = Range("AB2").End(xlDown).Row  'The number of unique Bore/Lith combinations

    Range("AC2").Select
        Application.CutCopyMode = False
        ActiveCell.Formula = "=COUNTIF($AA$2:$AA$" & NSamples & ",AB2)" 'Calculates the # of occurrences of a Lith in any one bore
        Selection.Copy
    Range("AC2:AC" & NTypes).Select
        ActiveSheet.Paste

    Application.CutCopyMode = False

LkUpRange = "$AB$2:$AC$" & NTypes  'Is the range of occurrences of a lith in any one bore

'Sets Headers
    Range("G1") = "Lithology"
    Range("H1") = "Bore"
    Range("I1") = "Dol No"
    Range("J1") = "Depth1"
    Range("K1") = "Depth2"
    Range("L1") = "Thickness"

For i = 2 To NSamples
    LkUpVal = Cells(i, 4) & Cells(i, 1)

    N_Occ = Application.VLookup(LkUpVal, Range(LkUpRange), 2, False)

        For b = 1 To N_Occ
            If b = 1 Then                   'will only enter the Lith and Bore for the 1st occurrence
                Cells(i, 7) = Cells(i, 4)
                    Cells(i, 8) = Cells(i, 1)
            End If

            Cells(i, 9) = "D0" & b
            Cells(i, 10) = Cells(i, 2)
            Cells(i, 11) = Cells(i, 3)
            Cells(i, 12) = Cells(i, 3) - Cells(i, 2)

            If b < N_Occ Then
                i = i + 1
                    End If
        Next b
Next i

Run ("SortBoreDepth")

End Sub
Posted 6 months ago #
Top
 
Enthusiast
Enthusiast
Posts: 566

@moreeg,

I will evaluate the code and get back to you.

Posted 6 months ago #
Top
 
moreeg
moreeg
Posts: 842

The prospect of Enthusiast's critique whilst very welcome, is also daunting so I had a second look at this and came up with much tighter (and hopefully more elegant) code. If judged by lines of code I've reduced it from about 140 lines to about 30. Plus, I've adhered to the original specs of extracting only 1 Lith for evaluation. The target Lith is hard coded but could easily be prompted. I would also rearrange the columns to make it easier to read but we can leave that up to Eligeol

Sub IsolateLith()

Application.ScreenUpdating = False      'set to True for debugging/False to improve performance

Sample = "dolerite"
NSamples = Range("A1").End(xlDown).Row     'number of samples
Range(Cells(1, 7), Cells(NSamples, 12)).ClearContents

'Sets Headers
    Range("G1") = "Bore"
    Range("H1") = "Depth1"
    Range("I1") = "Depth2"
    Range("J1") = "Lithology"
    Range("K1") = "Thickness"
    Range("L1") = "DOL#"

TRow = 2

    For i = 1 To NSamples

        If UCase(Trim(Cells(i, 4))) = UCase(Sample) Then
            Range(Cells(i, 1), Cells(i, 4)).Copy
            Cells(TRow, 7).PasteSpecial
            Cells(TRow, 11) = Cells(TRow, 9) - Cells(TRow, 8) 'Thickness
            Cells(TRow, 12) = 1
                    If Cells(TRow, 7) = Cells(TRow - 1, 7) And Cells(TRow, 12) <> "" Then
                        Cells(TRow, 12) = Cells(TRow - 1, 12) + 1
                            End If
            TRow = TRow + 1
        End If
    Next

End Sub
Posted 6 months ago #
Top
 
Eligeol
Posts: 31

Hi again!

Ok - file has been sent to Enthusiast and as soon as one of the mods provides the email for moreeg I'll forward same. Thanks again.

Posted 6 months ago #
Top
 
vistamike
vistamike
Posts: 10945

Eligeol, tis done

Posted 6 months ago #
Top
 

1 2