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

If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Pawan" wrote in message
...
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

Hi Pawan

This should do the trick. Place this code in a new module of a new
workbook. It will open all the files in a particular folder, identify
the unique values in column A of each sheet and return the workbook
name and sheet name to column A of "Sheet1" and the unique values
which correspond to this in Column B. You will need to change the
folder name and the sheet name if you want the result to appear
somewhere other than sheet1.

Take care

Marcus



Option Explicit
Sub GetUnique()
Dim oWbk As Workbook
Dim sFil As String
Dim sPath As String
Dim ws As Worksheet
Dim sh As Worksheet
Dim twbk As Workbook
Dim lw As Integer
Dim myVar As Integer
Dim lr As Integer
Dim MyShName As String
Dim myBkName As String

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set twbk = ThisWorkbook

sPath = "C:\users\excel" 'location of files
ChDir sPath
sFil = Dir("*.xls") 'you can limit the search by adding data in
front or behind the *
On Error GoTo ExitProg
'Step Thru each worksheet in activeworkbook

Do While sFil < "" 'opens the file read only
Set oWbk = Workbooks.Open(sPath & "\" & sFil,
ReadOnly:=True)

For Each ws In oWbk.Worksheets
ws.Activate
MyShName = ws.Name
myBkName = oWbk.Name
lw = Range("A" & Rows.Count).End(xlUp).Row
myVar = CountUniqueValues(Range("A1:A" & lw))
lr = twbk.Sheets("sheet1").Range("A" & Rows.Count).End
(xlUp).Row + 1
twbk.Sheets("sheet1").Range("B" & lr) = myVar
twbk.Sheets("sheet1").Range("A" & lr) = myBkName & " "
& MyShName

Next ws

oWbk.Close False
sFil = Dir
Set oWbk = Nothing
Loop

Set twbk = Nothing

ExitProg:

If Err 0 Then
MsgBox (Error(Err))
Err.Clear

End If

End Sub

Function CountUniqueValues(InputRange As Range) As Long
Dim cl As Range, UniqueValues As New Collection
Application.Volatile
On Error Resume Next ' ignore any errors
For Each cl In InputRange
UniqueValues.Add cl.Value, CStr(cl.Value) ' add the unique
item
Next cl
On Error GoTo 0
CountUniqueValues = UniqueValues.Count
End Function

this code put all the usique values into sheet1 of the workbook where
the macro is located. change the Variable Folder as required.

Sub GetUnique()

NewRow = 1
Set RsltSht = ThisWorkbook.Sheets("Sheet1")

Folder = "c:\temp\"
FName = Dir(Folder & "*.xls")
Do While FName < ""
Set bk = Workbooks.Open(Filename:=Folder & FName)
For Each sht In bk.Worksheets
With sht
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
Data = .Range("A" & RowCount)
If Data < "" Then
'lookup if data already exists
Set c = RsltSht.Columns("A").Find(what:=Data, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
'data didn't already exist
RsltSht.Range("A" & NewRow) = Data
NewRow = NewRow + 1
End If
End If
Next RowCount
End With
Next sht
bk.Close savechanges:=False
FName = Dir()
Loop




End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=151944

Microsoft Office Help

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

If you want to loop through all worksheets in the opened workbook, change the

Set oWS = ... to

for each oWS in oWB.Worksheet

next oWS

And put all the action on oWS in that loop


"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

Thanks Barb,

I tried this macro on one test file in one folder. However the macro
execution never stops. It keeps on executing and I need to interrupt it. I
think it keeps on opening the same workbook again and again. I tried to debug
but could not... :(

Regards,
prm

"Barb Reinhardt" wrote:

If you want to loop through all worksheets in the opened workbook, change the

Set oWS = ... to

for each oWS in oWB.Worksheet

next oWS

And put all the action on oWS in that loop


"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

Sorry about that. I forgot one important line. Before this line

Loop While myFile < ""

put this

myFile = Dir


--
HTH,

Barb Reinhardt



"Pawan" wrote:

Thanks Barb,

I tried this macro on one test file in one folder. However the macro
execution never stops. It keeps on executing and I need to interrupt it. I
think it keeps on opening the same workbook again and again. I tried to debug
but could not... :(

Regards,
prm

"Barb Reinhardt" wrote:

If you want to loop through all worksheets in the opened workbook, change the

Set oWS = ... to

for each oWS in oWB.Worksheet

next oWS

And put all the action on oWS in that loop


"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

Sorry about that. I forgot one important line. Before this line

Loop While myFile < ""

put this

myFile = Dir


--
HTH,

Barb Reinhardt



"Pawan" wrote:

Thanks Barb,

I tried this macro on one test file in one folder. However the macro
execution never stops. It keeps on executing and I need to interrupt it. I
think it keeps on opening the same workbook again and again. I tried to debug
but could not... :(

Regards,
prm

"Barb Reinhardt" wrote:

If you want to loop through all worksheets in the opened workbook, change the

Set oWS = ... to

for each oWS in oWB.Worksheet

next oWS

And put all the action on oWS in that loop


"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

Sorry about that. I forgot one important line. Before this line

Loop While myFile < ""

put this

myFile = Dir
--
HTH,

Barb Reinhardt



"Pawan" wrote:

Thanks Barb,

I tried this macro on one test file in one folder. However the macro
execution never stops. It keeps on executing and I need to interrupt it. I
think it keeps on opening the same workbook again and again. I tried to debug
but could not... :(

Regards,
prm

"Barb Reinhardt" wrote:

If you want to loop through all worksheets in the opened workbook, change the

Set oWS = ... to

for each oWS in oWB.Worksheet

next oWS

And put all the action on oWS in that loop


"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

Hi Pawan

The below macro would generate the unique list as a new sheet in your active
workbook. The macro would get data from all sheets of all workbooks present
in the folder. Launch VBE by hitting Alt+F11. From menu 'Insert' a module and
paste the below code. Get back to Workbook and run macro from Tools|Macro|Run
<selected macro(). Please note that there is a subprocedure. Try and
feedback..

Sub GenerateUniqueList()
Dim strFolder As String, strFile As String, ws As Worksheet

'Browse folder
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then MsgBox ("No folder selected"): End
strFolder = .SelectedItems(1) & "\"
End With

Set ws = ActiveWorkbook.Worksheets.Add(After:=ActiveSheet)
'Browse all files within the folder
Application.ScreenUpdating = False: Application.DisplayAlerts = False
strFile = Dir(strFolder & "*.xl*", vbNormal)
Do While strFile < ""
OpenAndGetData strFolder & strFile, ws
strFile = Dir
Loop

'Generate unique list
ws.Range("A1") = "Unique List"
ws.Columns(1).Sort Key1:=ws.Range("A2"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ws.Columns(1).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ws.Range("B1"), Unique:=True
Columns(1).Delete
Application.ScreenUpdating = True: Application.DisplayAlerts = True
MsgBox "Unique list generated"
End Sub

Sub OpenAndGetData(strWBook As String, ws As Worksheet)
Dim wbTemp As Workbook, wsTemp As Worksheet, lngRow As Long
Set wbTemp = Workbooks.Open(strWBook, ReadOnly:=True)
For Each wsTemp In wbTemp.Sheets
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wsTemp.Range("A1:A" & wsTemp.Cells(Rows.Count, _
"A").End(xlUp).Row).Copy ws.Range("A" & lngRow + 1)
Next
wbTemp.Close False
End Sub


If this post helps click Yes
---------------
Jacob Skaria


"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