Extracting data Macro

Posted by Keith on November 26, 2001 6:58 AM

I need help creating a macro. I have several (25) files. I want a macro that will go to each file and cut and paste a certain section of each into a new spreadsheet. Ideally, I want the macro to open the files from an array. I dont need data from all 25 files at once. Usually I need data fron @20, but its a different 20 each time I need the macro to run. What I would like to do is pick the files I need data from, perhaps from a dropdown list, and then run the macro. Thanks

Posted by Bariloche on November 26, 2001 8:30 PM

Keith,

Here's a macro that does a lot, if not all, of what you want. The one short-coming that it has is the multi-select list dialog box was created as a "dialog sheet" in Excel95 and I can't post it. I suggest that you just print this code out and use it as an example. Hope it helps.

Dim File() As String
Dim FoundFile As String
Dim FileCount As Integer
Dim strDataBookName As String
Dim strTemp As String
Dim DBoxList As DialogSheet
Dim lstMulti As ListBox

Sub ConvertMathCadData()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set DBoxList = ThisWorkbook.DialogSheets("DBoxList")
Set lstMulti = DBoxList.ListBoxes("lstMulti")
lstMulti.RemoveAllItems

FoundFile = Dir("U:\SS\MathCadTest\*.prn")

FileCount = 1
ReDim Preserve File(FileCount)
File(FileCount) = FoundFile

' The following creates the array with filenames in it
Do While FoundFile &LT;&GT; ""
FoundFile = Dir()
If FoundFile &LT;&GT; "" Then
FileCount = FileCount + 1
ReDim Preserve File(FileCount)
File(FileCount) = FoundFile
End If
Loop

For i = 1 To FileCount
lstMulti.List(i) = File(i)
Next i
' The next line is probably not needed in Excel97 and subs
DBoxList.DialogFrame.OnAction = "SetFocus"

If DBoxList.Show Then
MsgBox "Ahh! Success."
For i = 1 To FileCount
Debug.Print lstMulti.List(i)
Next i
Exit Sub
Else
MsgBox "Errrrrr!"
Exit Sub
End If

ChDir "U:\SS\MathCadTest"
Workbooks.Open lstMulti.Selected(1) 'File(1)
strDataBookName = ActiveWorkbook.Name
Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Copy
Range("B1").PasteSpecial Paste:=xlValues, Transpose:=True
Application.CutCopyMode = False
Range(Cells(1, 1), Cells(1, 1).End(xlDown)).ClearContents
Cells(1, 1).Value = Left(File(1), Len(File(1)) - 4)

For i = 2 To FileCount
Workbooks.Open File(i)
strTemp = ActiveWorkbook.Name
Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Copy
Workbooks(strDataBookName).Activate
Cells(i, 2).PasteSpecial Paste:=xlValues, Transpose:=True
Application.CutCopyMode = False
Workbooks(strTemp).Close
Cells(i, 1).Value = Left(File(i), Len(File(i)) - 4)
Next i

Cells(1, 1).Select
Application.Dialogs(xlDialogSaveAs).Show

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Remember, this is offered just as an example. You'll have to work through it to modify it to suit your needs (but its probably about 75% there, all except for the user form that you'd have to create any way.)

If you don't have John Walkenbach's book on Excel 2000 programming, I'd get it if I were you. It'll come in handy for modifying this code (as well as other stuff).

good luck