For those that have been following this here is the progress;

Part II of the problem required Eligeol to spell it out for me in Excel terms - the geological explanation was beyond me. In the end there were to new columns required;

TOD Elev .... which is the total elevation for a Bore which is listed in the Elevation spreadsheet minus the beginnig depth of a Dolerite layer

BOD Elev .... is the total elevation minus the ending depth of a Dolerite layer

The beginning and ending depths of Dolerite were extracted by the Macro. The 2 new columns were easily calculated using vlookup that matched the Bore name on the Dolerite Spreadsheet with the Bore name on the Elevation spreadsheet and extracted the Bore elevation for the particular Dolerite layer.

There was really no need to do this in a macro but I added it into the Macro nonetheless on the theory that if the same exercise was to be repeated for another lithography this macro approach might be simpler (I'm not totally convinced either).

Here is the macro that was used. As indicated above, I altered it so that the results were deposited into a new spreadsheet.

```
Sub IsolateLith()
Sample = "dolerite" 'Change this to the Lithology you want to analyse
Sheets(Sample).Activate 'Create a sheet with the name of the sample you are analysing
NSamples = Sheets("Lithology").Range("A1").End(xlDown).Row 'number of samples
Range(Cells(1, 1), Cells(NSamples, 20)).ClearContents 'Clear out existing results rows
Application.ScreenUpdating = False 'set to True for debugging/False to improve performance
'Sets Headers
Range("A1") = "Bore"
Range("B1") = "Depth1"
Range("C1") = "Depth2"
Range("D1") = "Lithology"
Range("E1") = "Thickness"
Range("F1") = "DOL#"
TRow = 2 'The first Target Row for results
For i = 1 To NSamples 'Will cycle through each Bore row in Lithology sheet
If UCase(Trim(Sheets("Lithology").Cells(i, 4))) = UCase(Trim(Sample)) Then 'when the Bore contains "Dolerite...."
Range(Sheets("Lithology").Cells(i, 1), Sheets("Lithology").Cells(i, 4)).Copy 'Copies the information from the original data and ...
Cells(TRow, 1).PasteSpecial 'Pastes it to the Dolerite results Target Row then ...
Cells(TRow, 5) = Cells(TRow, 3) - Cells(TRow, 2) 'Calculates thickness
If Cells(TRow, 1) <> Cells(TRow - 1, 1) Then 'If this is the 1st instance of Dolerite in the Bore
Cells(TRow, 6) = 1 'Sets the Dolerite layer number as '1'
Else 'If more than 1 Dolerite in a Bore
Cells(TRow, 6) = Cells(TRow - 1, 6) + 1 'Determine the Layer number of Dolerite in the Bore
End If
TRow = TRow + 1 'go to the next target row
End If
Next
NDol = Range("A1").End(xlDown).Row 'Number of resulting Dolerite samples
Range("H1") = "TOD Elev"
Range("H2").Formula = "=IFERROR(VLOOKUP(A2,Elevation!$A$1:$B$610,2,FALSE),"""")-B2"
Range("I1") = "BOD Elev"
Range("I2").Formula = "=IFERROR(VLOOKUP(A2,Elevation!$A$1:$B$610,2,FALSE),"""")-C2"
Range("H2:I2").Copy
Range("H2:I" & NDol).PasteSpecial
Application.CutCopyMode = False
Range("A1").Select
End Sub
```

.

.

.

You can see near the end of the macro where I just plonked in the vlookup formula (rather than creating a VBA algorithm to do the same thing)

Among other improvement I would make to this are;

Prompting for the lithology

Providing a listing of Lithologies from which to select

Automatically creating the new spreadsheet (or checking for its existence before proceeding)

.

.

.

This is a sample of the resulting spreadsheet

Here is a sample of the Elevation spreadsheet. Columns C and D were calculated using vlookups to the Dolerite spreadsheet. They are not included in the Macro.

The Dolerite spreadsheet containing the results of the Macro has over 1000 rows of data which will still be difficult to analyse for conclusions about the whole bore digging enterprise so Eligeol promises that at some point there will be a Part III to this saga.

Reports: ·
Posted 3 years ago