Count data from multiple files

**Leith Ross** · 05-16-2010, 01:21 PM

Hello Bob@Sun,

I fixed the macro to sum each representative's count based on the each day of the month. Here is the amended macro.

'Thread:  http://www.excelforum.com/excel-programming/729324-count-data-from-multiple-files.html#post2307113
'Poster:  Bob@Sun
'Written: May 15, 2010
'Updated: May 16, 2010
'Author:  Leith Ross

Sub CountCalls()

  Dim CalcWks As Worksheet
  Dim FileName As String
  Dim FilePath As String
  Dim Person As Variant
  Dim Month As Integer
  Dim NameList As Range
  Dim NameRng As Range
  Dim RngEnd As Range
  
   'Change the folder to where your files are stored
    FilePath = "C:\Documents and Settings\Admin.ADMINS\My Documents\Excel Forum Folders\Bob@Sun"
    
    Set CalcWks = ThisWorkbook.Worksheets("Sheet1")
    
    Set NameRng = CalcWks.Range("A3")
    Set RngEnd = CalcWks.Cells(Rows.Count, NameRng.Column).End(xlUp)
    Set NameRng = IIf(RngEnd.Row > NameRng.Row, CalcWks.Range(NameRng, RngEnd), NameRng)
  
    Set NameList = NameRng
    
      Application.ScreenUpdating = False
      FileName = Dir(FilePath & "\")
      
        Do While FileName <> ""
          
          If FileName Like "*_########.xls" Then
            Set Wkb = Workbooks.Open(FilePath & "\" & FileName)
            Month = Val(Mid(Wkb.Name, 14, 2))
      
            Set NameRng = Wkb.Worksheets("Sheet1").Range("L2")
            Set RngEnd = NameRng.Parent.Cells(Rows.Count, NameRng.Column).End(xlUp)
            Set NameRng = IIf(RngEnd.Row > NameRng.Row, NameRng.Parent.Range(NameRng, RngEnd), NameRng)
      
            For Each Person In NameList
              Person.Offset(0, Month) = Person.Offset(0, Month) + WorksheetFunction.CountIf(NameRng, Person)
            Next Person
           
            Wkb.Close False
          End If
          FileName = Dir()
          
        Loop
            
      Application.ScreenUpdating = True
      
End Sub

**Bob@Sun** · 05-16-2010, 02:09 PM

Hi Leith,

I have posted another problem that I have faced. Probalby I did not have time to check that.

Originally Posted by Bob@Sun

I have tried to change the countif function with Evaluate.
When I use ""Peter"" in the formula everything is ok, but when change it to " & Person & "
I am getting an error.

What is wrong?

Sub CountCalls()

  Dim CalcWks As Worksheet
  Dim FileName As String
  Dim FilePath As String
  Dim Person As Variant
  Dim Month As Integer
  Dim NameList As Range
  Dim NameRng As Range
  Dim RngEnd As Range
  
   'Change the folder to where your files are stored
    FilePath = "D:\Documents\EXCEL VBA\TESTING"
    
    Set CalcWks = ThisWorkbook.Worksheets("Sheet1")
    
    Set NameRng = CalcWks.Range("A3")
    Set RngEnd = CalcWks.Cells(Rows.Count, NameRng.Column).End(xlUp)
    Set NameRng = IIf(RngEnd.Row > NameRng.Row, CalcWks.Range(NameRng, RngEnd), NameRng)
  
    Set NameList = NameRng
    
      Application.ScreenUpdating = False
      FileName = Dir(FilePath & "\")
      
        Do While FileName <> ""
          
          If FileName Like "*_########.xls" Then
            Set Wkb = Workbooks.Open(FilePath & "\" & FileName)
            Month = Val(Mid(Wkb.Name, 14, 2))
      
            Set NameRng = Wkb.Worksheets("Sheet1").Range("L2")
            Set RngEnd = NameRng.Parent.Cells(Rows.Count, NameRng.Column).End(xlUp)
            Set NameRng = IIf(RngEnd.Row > NameRng.Row, NameRng.Parent.Range(NameRng, RngEnd), NameRng)
      
            For Each Person In NameList
               Person.Offset(0, Month) = Application.Evaluate("SUMPRODUCT(--(L1:L100=" & Person & "),--(M1:M100=""OK""))") +  Person.Offset(0, Month)
            Next Person
           
            Wkb.Close False
          End If
          FileName = Dir()
          
        Loop
            
      Application.ScreenUpdating = True
      
End Sub

**Leith Ross** · 05-16-2010, 02:45 PM

Hello Bob@Sun,

I don't understand your last post. It is looks to be a repost of the previous one. The macro in my last post fixes the monthly total problem. Did you not run it? Is there another problem? If so, please give me examples of the problems.

**Bob@Sun** · 05-16-2010, 02:55 PM

Oh ok,

My problem now is that I am trying to change the countif function with Evaluate("Sumproduct.....), but I am having problems with that.

For Each Person In NameList
               Person.Offset(0, Month) = Application.Evaluate("SUMPRODUCT(--(L1:L100=" & Person & "),--(M1:M100=""OK""))") +  Person.Offset(0, Month)
            Next Person

The problem comes when declaring " & Person &" in the formula. If I write just the name like this ""Peter"" everything is ok, but when I chage it to Person I am getting error.

What is wrong?

**Leith Ross** · 05-16-2010, 03:04 PM

Hello Bob@Sun,

"Person" is a cell in the range "NameList". NameList is the range of names in column "A" of "Sheet1" in workbook "Calculate Data.xls". Person represents the cell as a Range Object and not just the contents of the cell.

**Bob@Sun** · 05-16-2010, 03:12 PM

How can I transfer Person to represent the contents of the cell?

**Leith Ross** · 05-16-2010, 03:16 PM

Hello Bob@Sun,

Try this ...

 
  & Person.Text &

**Bob@Sun** · 05-16-2010, 03:32 PM

I get the "Type mismatch" error

**Bob@Sun** · 05-16-2010, 03:34 PM

I removed this...

+  Person.Offset(0, Month)

and I got true, but in the cell I still get the #NAME? error? while in the inmidiate window I am getting the names wright.

**Leith Ross** · 05-16-2010, 03:40 PM

Hello Bobo@Sun,

I don't know what the problem is because I don't understand the logic of the statement.

**Bob@Sun** · 05-16-2010, 03:50 PM

If this is the whole code...

Sub CountCalls()

  Dim CalcWks As Worksheet
  Dim FileName As String
  Dim FilePath As String
  Dim Person As Variant
  Dim Month As Integer
  Dim NameList As Range
  Dim NameRng As Range
  Dim RngEnd As Range
  
   'Change the folder to where your files are stored
    FilePath = "D:\Documents\EXCEL VBA\TESTING"
    
    Set CalcWks = ThisWorkbook.Worksheets("Sheet1")
    
    Set NameRng = CalcWks.Range("A3")
    Set RngEnd = CalcWks.Cells(Rows.Count, NameRng.Column).End(xlUp)
    Set NameRng = IIf(RngEnd.Row > NameRng.Row, CalcWks.Range(NameRng, RngEnd), NameRng)
  
    Set NameList = NameRng
    
      Application.ScreenUpdating = False
      FileName = Dir(FilePath & "\")
      
        Do While FileName <> ""
          
          If FileName Like "*_########.xls" Then
            Set Wkb = Workbooks.Open(FilePath & "\" & FileName)
            Month = Val(Mid(Wkb.Name, 14, 2))
      
            Set NameRng = Wkb.Worksheets("Sheet1").Range("L2")
            Set RngEnd = NameRng.Parent.Cells(Rows.Count, NameRng.Column).End(xlUp)
            Set NameRng = IIf(RngEnd.Row > NameRng.Row, NameRng.Parent.Range(NameRng, RngEnd), NameRng)
      
            For Each Person In NameList
               Person.Offset(0, Month) = Application.Evaluate("SUMPRODUCT(--(L1:L100=" & Person.Text & "),--(M1:M100=""OK""))") _
                           + Person.Offset(0, Month)
            Next Person
           
            Wkb.Close False
          End If
          FileName = Dir()
          
        Loop
            
      Application.ScreenUpdating = True
      
End Sub

If I run the code I am gettting "type mismatch" error.
I guess I have to cange something in this part to make it work...

 For Each Person In NameList
               Person.Offset(0, Month) = Application.Evaluate("SUMPRODUCT(--(L1:L100=" & Person.Text & "),--(M1:M100=""OK""))") _
                           + Person.Offset(0, Month)
            Next Person

**Bob@Sun** · 05-18-2010, 06:57 AM

I have chage the code to this.....

Sub CountCalls()

  Dim CalcWks As Worksheet
  Dim FileName As String
  Dim FilePath As String
  Dim Person As Variant
  Dim Month As Integer
  Dim NameList As Range
  Dim NameRng As Range
  Dim RngEnd As Range
    
   'Change the folder to where your files are stored
    FilePath = "D:\Documents\EXCEL VBA\TESTING"
      
      Application.ScreenUpdating = False
      FileName = Dir(FilePath & "\")
      
        Do While FileName <> ""
          
          If FileName Like "*_########.xls" Then
            Set Wkb = Workbooks.Open(FilePath & "\" & FileName)
            Month = Val(Mid(Wkb.Name, 14, 2))
      
           Set NameRng = Wkb.Worksheets("Sheet1").Range("L2")
           Set RngEnd = NameRng.Parent.Cells(Rows.Count, NameRng.Column).End(xlUp)
           Set NameRng = IIf(RngEnd.Row > NameRng.Row, NameRng.Parent.Range(NameRng, RngEnd), NameRng)
      
ReDim NamesFound(0) As String
ReDim NamesFound(50) As String
i = 0
For Each Item In NameRng
                
Nameaddress = Item.Address


If IsInArray(Item, NamesFound) = False Then
NamesFound(i) = Item
            
    Wkb.Activate
              
                Count = Application.Evaluate("SUMPRODUCT(--(L1:L100=" & Nameaddress & "),--(M1:M100=""OK""))")
       With ThisWorkbook
       .Activate
               Cells.Find(What:=NamesFound(i), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Select
        
                Selection.Offset(0, Month).Value = Selection.Offset(0, Month).Value + Count
        End With

Else
End If


 i = i + 1
Next Item
     
Wkb.Close False
End If
FileName = Dir()

        Loop
            
      Application.ScreenUpdating = True
      
End Sub

and this is doing the job

Leith and JBeaucaire,

Thanks for the help!

Thread: Count data from multiple files

Thread Tools

Display

Re: Count data from multiple files

Re: Count data from multiple files

Re: Count data from multiple files

Re: Count data from multiple files

Re: Count data from multiple files

Re: Count data from multiple files

Re: Count data from multiple files

Re: Count data from multiple files

Re: Count data from multiple files

Re: Count data from multiple files

Re: Count data from multiple files

Re: Count data from multiple files

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions