# Macro to create new workbook based on values of other workbooks in a directory.

Hello,
I have several workbooks in a directory.  I would like a macro (or other automated way) to go through each workbook in the directory and examine the values of the following cells:

L21, L39, L59 and L80

I want to know the cell with the smallest value.  I then would like the macro to paste the filename of the workbook in the first column and the following depending on which cell above is the smallest:

L21 = Linear
L59 = Cubic
L80 = Quartic

I have attached a sample input workbook and the output workbook.
Annotated code is really appreciated,
Thanks,
JE
column-pforperFRAG-and-CONTAG--g.xls
je-ee-sample-output.xlsx
###### Who is Participating?

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Commented:
your input file has no values in Column L, rows 21,39,59,

do you mean find the type with lowest P inc in r2.  ie Column I  ?
Author Commented:
Ha. Yes
Author Commented:
To clarify, yes the original R2 value and then the increase in R2, column I, not L.

Cheers,
JE
Commented:
attached is my test workbook with code in module
Option Explicit
Sub ProcessFolder()

Dim sFileFilter As String, sFolderName As String, sActionFile As String
Dim wbAction As Workbook, wsAction As Worksheet
Dim rOutput As Range
Dim dMinVal As Double, sMinName As String

Set rOutput = ActiveSheet.Range("A1")

sFileFilter = "column*.xls?"
sFolderName = "c:\ee"

sActionFile = Dir$(sFolderName & "\" & sFileFilter, vbNormal) Do While sActionFile <> "" Set wbAction = Workbooks.Open(Filename:=sActionFile, ReadOnly:=True) Set wsAction = wbAction.Sheets("statpolyreg") 'set initials dMinVal = wsAction.Range("I21").Value sMinName = "Linear" If dMinVal > wsAction.Range("I39").Value Then 'adopt Quad dMinVal = wsAction.Range("I39").Value sMinName = "Quadratic" End If If dMinVal > wsAction.Range("I59").Value Then 'adopt Quad dMinVal = wsAction.Range("I59").Value sMinName = "Cubic" End If If dMinVal > wsAction.Range("I80").Value Then 'adopt Quad dMinVal = wsAction.Range("I80").Value sMinName = "Quartic" End If 'save the result from this workbook rOutput.Value = sActionFile rOutput.Offset(0, 1) = sMinName 'close the action book wbAction.Close (False) 'move to next records Set rOutput = rOutput.Offset(1, 0) sActionFile = Dir$()
Loop
End Sub

je-ee-sample-output.xlsm

Experts Exchange Solution brought to you by