Extracting data on multiple files from one folder
Try this. Keep in mind that this is completely untested. I did create a new
workbook to save the data to. You can modify as needed.
Option Explicit
Option Base 1
Sub OpenAndCountUnique()
Dim myUnique() As Variant
Dim r As Excel.Range
Dim myRange As Excel.Range
Dim oWB As Excel.Workbook
Dim myFolder As String
Dim myFile As String
Dim aWB As Excel.Workbook
Dim aWS As Excel.Worksheet
Dim oWS As Excel.Worksheet
Dim i As Long
Dim oWSlRow As Long
Dim aWSlRow As Long
Dim myCell As Excel.Range
Dim myCount As Long
Dim Match As Boolean
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = False Then
MsgBox ("No folder selected. Execution ending.")
End
End If
myFolder = .SelectedItems(1)
End With
myFolder = myFolder & "\"
myFile = Dir(myFolder & "*.x*")
If myFile = "" Then
MsgBox ("There are no excel files in the selected folder. Execution
ending.")
End
End If
myCount = 0
On Error Resume Next
myCount = UBound(myUnique)
On Error GoTo 0
Do
Set oWB = Workbooks.Open(myFolder & myFile, Readonly:= True)
'selects first worksheet in file, change as needed
Set oWS = oWB.Worksheets(1)
'Determines last row on oWS column 1. Change as needed
oWSlRow = oWS.Cells(oWS.Rows.Count, 1).End(xlUp).Row
For i = 1 To oWSlRow
Set myCell = oWS.Cells(i, 1)
If Not IsEmpty(myCell) Then
If myCount = 0 Then
myCount = myCount + 1
ReDim Preserve myUnique(myCount)
myUnique(myCount) = myCell.Text
Else
Match = False
For j = 1 To myCount
If LCase(myUnique(j)) = LCase(myCell.Text) Then
Match = True
Exit For
End If
Next j
If Not Match Then
myCount = myCount + 1
ReDim Preserve myUnique(myCount)
myUnique(myCount) = myCell.Text
End If
End If
Next i
oWB.Close
Loop While myFile < ""
myCount = UBound(myUnique)
If myCount 0 Then
'Created a new workbook
Set aWB = Workbooks.Add
Set aWS = aWB.Worksheets(1) 'Saves to first worksheet
For i = 1 To myCount
aWSlRow = i 'You may want to add a header and change this #
aWS.Cells(aWSlRow, 1).Value = myUnique(i)
Next i
End If
End Sub
HTH,
Barb Reinhardt
"Pawan" wrote:
Hello
I have a folder with several excel files in it. I want to write a macro in
new workbook. This macro should count the number of used 'unique' cells from
column "A" of all the excel sheets. The result should be added in one sheet
of the book (in which macro is written).
Thank You
Regards,
prm
|