Find Max and Min plus Date of each Max and Min using an excel script

Hi there,

I have multiple workbooks containing the water level data for a particular bore.

So if the bore is listed 46217, it will have its own workbook and contain a series of columns listing the date the water level was taken, the water level and other details.

What I want to do is create a script that will create a separate excel file containing the max and min water level (the column labeled WLMP__m_), plus the date of each value for each bore/workbook.

There is approx 140 workbooks and I need to complete this for each one.

I have attached one of the files as an example.

Thanks,

Mick

If Data layouts and sheet naming rule are the same in each workbook, try

Sub test()
    Dim myDir As String, fn As String, n As Long, wsName As String, FileName As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & "\"
    End With
    If myDir = "" Then Exit Sub
    fn = Dir(myDir & "*.xls")
    If fn = "" Then Exit Sub
    With Sheets(1)
        .Cells(1).CurrentRegion.ClearContents: n = 1
        .Cells(1).Resize(, 5).Value = Array("BORE_ID", "Max", "Date", "Min", "Date")
        Do While fn <> ""
            n = n + 1: wsName = Left$(fn, InStrRev(fn, ".") - 1)
            FileName = "'" & myDir & "[" & fn & "]" & wsName & "'!"
            .Cells(n, 1).Value = wsName
            .Cells(n, 2).Value = ExecuteExcel4Macro("max(" & FileName & "c5:c5)")
            .Cells(n, 3).Value = ExecuteExcel4Macro("index(" & FileName & _
                        "c2:c2,match(" & .Cells(n, 2).Value & "," & FileName & "c5:c5,0),)")
            .Cells(n, 4).Value = ExecuteExcel4Macro("min(" & FileName & "c5:c5)")
            .Cells(n, 5).Value = ExecuteExcel4Macro("index(" & FileName & _
                        "c2:c2,match(" & .Cells(n, 4).Value & "," & FileName & "c5:c5,0),)")
            fn = Dir
        Loop
        .Range("c:c,e:e").NumberFormat = "yyyy/m/d"
    End With
End Sub

Thanks Jindon,

Sorry I'm a fairly basic VBA guy, so if you could explain a few things that would be great.

Do I need to change any directories in this code to suit my own? When I run the script it prompts me to locate a folder - is that folder the location of all excel files?

Thanks so much for your reply!

Mick

Actually I've just worked it out and it works perfectly! Fantastic!

What do you think is the best way to learn VBA? It's a very handy tool!

1)
Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found at http://www.excelforum.com/forum-rule...rum-rules.html

2)

Originally Posted by mickcondon89

If I wanted to extract the first line of data and the last line of data from each spread sheet, would that be possible?

How do you want the output to accompany current the results?
If upload a result workbook, it may help.

Oh sorry about that!

I'll make sure I do that next time.

I would want the output alongside the max and min data. Pretty much in the same way as before. Even a seperate workbook is fine!

Not really clear.

Sub test()
    Dim myDir As String, fn As String, n As Long, wsName As String, FileName As String, x
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & "\"
    End With
    If myDir = "" Then Exit Sub
    fn = Dir(myDir & "*.xls")
    If fn = "" Then Exit Sub
    With Sheets(1)
        .Cells(1).CurrentRegion.ClearContents: n = 1
        .Cells(1).Resize(, 5).Value = Array("BORE_ID", "Max", "Date", "Min", "Date")
        Do While fn <> ""
            n = n + 1: wsName = Left$(fn, InStrRev(fn, ".") - 1)
            FileName = "'" & myDir & "[" & fn & "]" & wsName & "'!"
            .Cells(n, 1).Value = wsName
            .Cells(n, 2).Value = ExecuteExcel4Macro("max(" & FileName & "c5:c5)")
            .Cells(n, 3).Value = ExecuteExcel4Macro("index(" & FileName & _
                        "c2:c2,match(" & .Cells(n, 2).Value & "," & FileName & "c5:c5,0),)")
            .Cells(n, 4).Value = ExecuteExcel4Macro("min(" & FileName & "c5:c5)")
            .Cells(n, 5).Value = ExecuteExcel4Macro("index(" & FileName & _
                        "c2:c2,match(" & .Cells(n, 4).Value & "," & FileName & "c5:c5,0),)")
            With .Cells(n, 7).Resize(, 20)
                .Formula = "=if(" & FileName & "a2<>""""," & FileName & "a2,"""")"
                .Value = .Value
            End With
            n = n + 1
            x = ExecuteExcel4Macro("counta(" & FileName & "c1:c1)")
            With .Cells(n, 7).Resize(, 20)
                .Formula = "=if(" & FileName & "a" & x & "<>""""," & FileName & "a" & x & ","""")"
                .Value = .Value
            End With
            fn = Dir
        Loop
        .Range("c:c,e:e").NumberFormat = "yyyy/m/d"
    End With
End Sub