macro help (excel2003)

[dubdub]

hi all,
I have big folder that has many files. The name of the files is the same, the only change is the well number. Attched is a sample of the file data format. What I want to do is extract the data line

[sdckapr]

Will the row always be the same in all the files? What is the max number of formations? Are they all labeled the same?

Steve

[LegareColeman]

I think the macro below will do close to what you want. You will need to change the line that reads:

<code>
strPath = "C:WorkWell"
</code>



to point to your directory where the files are stored.

The macro will go through all of the files in that directory and extract the data. Since the files may contain different numbers of columns, it will put the TOTAL in column B and will not put any column headers in row 1. You will need to add the column headers and move the TOTAL column where you want it.

<code>
Option Explicit


Public Sub ExtractData()
Dim strPath As String, strFile As String
Dim oTgtWB As Workbook, oTgtSH As Worksheet, oDWS As Worksheet
Dim lRow As Long, lCol As Long, lTRow As Long
Set oDWS = ActiveSheet
oDWS.Range("A2:IV65536").ClearContents
strPath = "C:WorkWell"
strFile = ""
strFile = Dir(strPath & "*.xls")
lTRow = 1
Do While strFile <> ""
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Set oTgtWB = Workbooks.Open(strPath & strFile)
Set oTgtSH = oTgtWB.Worksheets("PAYSUMMARY")
For lRow = oTgtSH.Range("A65536").End(xlUp).Row - 1 To 1 Step -1
If Trim(oTgtSH.Range("A1").Offset(lRow, 0).Value) = "Por * h * so, ft" Then Exit For
Next lRow
If lRow > 0 Then
oDWS.Range("A1").Offset(lTRow, 0).Value = Left(oTgtWB.Name, InStr(6, oTgtWB.Name, "_") - 1)
lCol = oTgtSH.Range("IV1").Offset(lRow, 0).End(xlToLeft).Column - 1
oDWS.Range("B1").Offset(lTRow, 0).Value = oTgtSH.Range("A1").Offset(lRow, lCol).Value
Range(oTgtSH.Range("A1").Offset(lRow, 1), oTgtSH.Range("A1").Offset(lRow, lCol - 1)).Copy
oDWS.Paste Destination:=oDWS.Range("C1").Offset(lTRow)
lTRow = lTRow + 1
End If
NextFile:
oTgtWB.Close
strFile = Dir
Application.ScreenUpdating = True
Loop
Exit Sub
ErrHandler:
MsgBox "Error processing file " & strFile
Resume NextFile
End Sub
</code>


Edited by Legare Coleman to add error handling.

[dubdub]

Hi Steve,
Yes the row is same in all the files, I don

[dubdub]

Hi LegareColeman,

Many thanks for your reply, I am outside the office now but surely I will try it tomorrow.

Regards

[dubdub]

Hi LegareColeman,

I ran it and it did the extract, but there is no formations label to orderly place the extracted data under the right formation label.

Can you please modify the code to allow me to enter the formation(s) label in certain columns and the code will do the extract of data line

[LegareColeman]

Sorry, I don't understand what you are asking. Could you give a detailed explaination of what you want to do?

[dubdub]

Hi Legare Coleman,

Each file in the folder represents a well and in each well there are formations (column headers) and data for each formation, as in my attachment, I have formation1, 2, 3, 4&5. The next well may have the same formation names, disappearance of some or additional ones. As such the extracted data has to be tied to a specific column header (formation).

If the code can be modified to allow me to specify the name of say up to 30 formations and extract the corresponding data from all the files for these formations that will be what I need.

Regards.

[LegareColeman]

If there is a column in one of the files where the header does not match one you have specified, what do you want to do? Do you want to be notified with a message box and skip it? Just skip it? Add a column to what you have specified? Something else?

[dubdub]

If I specify the headers and it happened that there is a header in one of the files that I did not specify, then adding a column with a header of the un-specified one and extracting it's data from all the files that have it will be excellent.

dubdub

[LegareColeman]

I took a guess at what you wanted since I am going out of town for a few days tomorrow morning. See if the macro in the attached workbook does what you need.

[LegareColeman]

Well, I guessed wrong, so ignore the post I just made. I'll have to modify what I just did.

[LegareColeman]

Ok, try the macro in the attached file.

[dubdub]

Many thanks, i have tested it with three files only and it works excellent. have a safe trip and a safe return.

dubdub