# 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?
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  ?
0
Author Commented:
Ha. Yes
0
Author Commented:
To clarify, yes the original R2 value and then the increase in R2, column I, not L.

Cheers,
JE
0
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
0

Experts Exchange Solution brought to you by

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Author Commented:
Thanks. This works well.
0
###### It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.