SEARCH

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 2 years ago by Eligeol
  • Latest reply from Eligeol
  • Topic Viewed 3983 times

moreeg
moreeg
Posts: 842

Hi Vincent

Glad to see you back and, hopefully, fully recovered.

I was surprised at the number of errors that came up. Perhaps we should be looking at whatever program is used to generate the raw data. :)
Also, just out of curiousity, how many bores were there?

Well ... It was fun while it lasted but I can't think of anything else that will add any more value to this. Thanks Vincent - I learned a lot from this about how the professionals construct code.

Posted 2 years ago
Top
 
Enthusiast
Enthusiast
Posts: 566

I'm getting there. It appears that the raw bores are processed by hand, with technicians manually entering the layer data. This process allows transcription errors to get into the data that we have been processing. I gather from Eligeol that the processing we have been doing is to prepare (clean) the data for an analysis. There are 522 bores in the data that was sent. The macro processes them in under 10 seconds.

Yes, there doesn't appear to be much more that needs to be done with this project. I would suggest to Eligeol that if other layers need to be removed, he can copy the Analyze macro to another macro, substituting the word "Dolerite" in the macro with the layer that he requires to be removed, and run that macro against the results of the first. Successive removals can be performed in this fashion.

Moreeg, as always, it has been fun working with you on this. Looking forward to the next time :)

To Eligeol, continue asking questions about this if necessary. I am happy to help when I can.

I decided to make a final posting of the macro. This one reports the number of bores processed:

Sub Analyze()
'
' Analyze Macro
'
' Keyboard Shortcut: Ctrl+a
'
' Macro recorded by Enthusiast
'
' This macro generates a report of sediment layers and thicknesses 6 columns
' to the right of the supplied data and standardizes the numeric values with
' 2 decimal places. To rerun report, delete the report columns then
' re-execute the macro.
'
Dim Firstrow As Long 'First row of data
Dim Lastrow As Long ' Last row of data
Dim Lrow As Long ' Current row being processed
Dim CalcMode As Long ' Save calculation state here
Dim ViewMode As Long ' Save view state here

Dim strDescription As String ' Current description, used to detect Layer to be removed
Dim strBoreDescription As String ' Current Bore description, used to determine when we are processing a new Bore

Dim strBoreColumn As String ' Column Bore is in
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 strCommentColumn As String ' Column Comment is in

Dim strRptBoreColumn As String ' Column Bore is in for report
Dim strRptLayerTypeColumn As String ' Column Layer Type is in for report
Dim strRptLayerBeginColumn As String ' Column Layer Begin is in for report
Dim strRptLayerEndColumn As String ' Column Layer End is in for report
Dim strRptCommentColumn As String ' Column Comment is in for report

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
Dim NumBores As Integer 'Number of Bores in the data

'Initialize NumBores
NumBores = 0

'Set column for Bore
strBoreColumn = "A"
strRptBoreColumn = "G"

'Set column for LayerBegin
strLayerBeginColumn = "B"
strRptLayerBeginColumn = "H"

'Set column for LayerEnd
strLayerEndColumn = "C"
strRptLayerEndColumn = "I"

'Set column for LayerType
strLayerTypeColumn = "D"
strRptLayerTypeColumn = "J"

'Set column for Comment
strCommentColumn = "E"
strRptCommentColumn = "K"

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

'Using the ActiveSheet
With ActiveSheet

'Select the sheet so we can change the window view
.Select

'Change LayerBegin and LayerEnd columns on report to number format
'with 2 decimal places, for consistency
.Columns(strRptLayerBeginColumn).NumberFormat = "0.00"
.Columns(strRptLayerEndColumn).NumberFormat = "0.00"

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

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

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

'Set Output start row for the report
rptRow = 1

'Initialize Delta
dblDelta = 0

'Print report header
.Cells(rptRow, strRptBoreColumn).Value = .Cells(rptRow, strBoreColumn).Value
.Cells(rptRow, strRptLayerBeginColumn).Value = .Cells(rptRow, strLayerBeginColumn).Value
.Cells(rptRow, strRptLayerEndColumn).Value = .Cells(rptRow, strLayerEndColumn).Value
.Cells(rptRow, strRptLayerTypeColumn).Value = .Cells(rptRow, strLayerTypeColumn).Value
.Cells(rptRow, strRptCommentColumn).Value = .Cells(rptRow, strCommentColumn).Value

'Increment report row
rptRow = rptRow + 1

'Set BoreDescription to initial value
strBoreDescription = .Cells(rptRow, strBoreColumn).Value

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

'If this is the first row of a new Bore, reset dblDelta, print the line and repeat process
If strBoreDescription <> .Cells(Lrow, strBoreColumn).Value Then

'Increment NumBores
NumBores = NumBores + 1

'Reset Bore Description
strBoreDescription = .Cells(Lrow, strBoreColumn).Value

'Reset Delta
dblDelta = 0

End If

'***************************************************************
'Highlight start of new bore
If .Cells(Lrow, strLayerBeginColumn).Value = 0 Then
Range(Cells(Lrow, strBoreColumn), Cells(Lrow, strCommentColumn)).Interior.Color = 776960
Range(Cells(rptRow, strRptBoreColumn), Cells(rptRow, strRptCommentColumn)).Interior.Color = 776960
End If
'**************************************************************

'Set Description to initial value
strDescription = .Cells(Lrow, strLayerTypeColumn).Value

'Begin Layer values are in column strLayerBeginColumn
'This code ensures dblBegin contains numeric data
If Not IsError(.Cells(Lrow, strLayerBeginColumn).Value) Then
dblBegin = .Cells(Lrow, strLayerBeginColumn).Value
Else
dblBegin = Val(.Cells(Lrow, strLayerBeginColumn).Value)
End If

'End Layer values are in column strLayerEndColumn
'This code ensures dblBegin contains numeric data
If Not IsError(.Cells(Lrow, strLayerEndColumn).Value) Then
dblEnd = .Cells(Lrow, strLayerEndColumn).Value
Else
dblEnd = Val(.Cells(Lrow, strLayerEndColumn).Value)
End If

'************************************************************************************************
'Finds errors in the input where depth2 does not equal next layer depth1
If .Cells(Lrow, strLayerBeginColumn) <> 0 And .Cells(Lrow - 1, strLayerEndColumn) <> .Cells(Lrow, strLayerBeginColumn) Then
    MsgBox ("ROW: " & Lrow)
    'Return screen updates and auto-calculation to initial settings
    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With

    'Move pointer to the line with the error
    .Cells(Lrow, strLayerBeginColumn).Select

    'End the macro
    Exit Sub
End If
'*************************************************************************************************

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

' Add thickness of removed layer to Delta
dblDelta = dblDelta + (dblEnd - dblBegin)

'Highlight row being removed Medium Light Green
Range(Cells(Lrow, 1), Cells(Lrow, 5)).Select
Selection.Interior.Color = 16776960

Else

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

'increment report line
rptRow = rptRow + 1

End If

Next Lrow

End With

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

'Display Number of Bores
MsgBox ("Number of Bores: " & NumBores)

End Sub
Posted 2 years ago
Top
 
moreeg
moreeg
Posts: 842

Hey Vincent

Good addition although it seems to skip the initial bore in the count (easy for me to see because I only have 2 bores in my sample). You can set the initial count to 1 ...

Moree

Posted 2 years ago
Top
 
Enthusiast
Enthusiast
Posts: 566

Yeah, that will do it. I didn't want to count 522, err 523 bores to verify the count :)

Posted 2 years ago
Top
 
moreeg
moreeg
Posts: 842

523 holes in the ground!!!????? Wait till the environmentalists hear about this. What ARE they looking for?

Posted 2 years ago
Top
 
Enthusiast
Enthusiast
Posts: 566

LOL, Eligeol would have to answer that. From what I have seen of the bores, I am thinking coal deposits, but that is just a guess.

Posted 2 years ago
Top
 
Lighthouse
Lighthouse
Posts: 13598

Those pesky gophers again.

Posted 2 years ago
Top
 
Eligeol
Posts: 31

Hi all,

Sorry for the late reply - been away from office (and internet) for the last few days. Thanks for the macro and all the efforts put in by Vincent and moreeg - I really appreciate it - especially since it completes the task in a fraction of the time it would have taken me to do it! Yes, you are quite right - tech's were used to input the data and unfortulately this was a) from handwritten logs and b) done by people who weren't able to double check for errors.

To answer the broader question - we are looking for coal in a rather large area so all of these holes are distributed over an extensive area. And not to worry according to our Evironmental Management Plan we rehabilitate all holes to the point that you wouldnt be able to see where we drilled two weeks after drilling :)

Thanks again - I look forward to challenging you again in the not-too-distant future :)

Keep well!

Accepted Answer · Posted 2 years ago
Top
 
Enthusiast
Enthusiast
Posts: 566

You are quite welcome :) Imagine... rehabilitated holes, hehehe

Posted 2 years ago
Top
 
Lighthouse
Lighthouse
Posts: 13598

No gophers were harmed in the re-filling of the holes :)

Posted 2 years ago
Top
 
Eligeol
Posts: 31

hehe - no :)

Posted 2 years ago
Top
 



Topic Closed

This topic has been closed to new replies.