Need to open the file and Countif function in the below mentioned VBA code (example in table)

[Ali_1984]

Hi Guys,

I am new to this forum. Can you please help me on the below requirement

I am getting the File names and date modified in the below code but i wanted to add one more thing in that.
Once File names and date modified completed. after that i wanted to open each file and know the text. Countif function.

The very last i have mentioned in the Table. what i need seems.

---------


Sub filenames()
Set Fobj = CreateObject("Scripting.FileSystemObject")

outgoing_str = "C:\Users\mali16\Desktop\All Data\Div1"
Set SourceFolder = Fobj.GetFolder(outgoing_str)
For Each f In SourceFolder.Files
no_of_files = no_of_files + 1
Next f

str1 = outgoing_str

Set myFolder = Fobj.GetFolder(str1)
i = 2
f = no_of_files

For Each f In myFolder.Files
'If ((Int(Left(f.Name, 4)) = current_year) And (Int(Right(Left(f.Name, 6), 2)) >= current_month)) Then
'f.SearchSubFolders = True
'ThisWorkbook.Sheets("Sheet1").Range("g" & i).Value = (" " & f.Name & " ")
ThisWorkbook.Sheets("Sheet1").Range("A1") = "Filename"
ThisWorkbook.Sheets("Sheet1").Range("b1") = "Datemodified"
ThisWorkbook.Sheets("Sheet1").Range("b" & i).Value = f.DateLastModified
ThisWorkbook.Sheets("Sheet1").Range("a" & i).Value = f.Name
'ThisWorkbook.Sheets("Sheet3").Range("d" & I).Value = f.Size
i = i + 1
'End If
Next

Sheet1.Select
Sheet1.Range("A2:B" & Range("B65000").End(xlUp).Row).Copy
Sheet1.Range("E" & Range("E65000").End(xlUp).Row + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlFormats
Sheet1.Range("E:F").EntireColumn.AutoFit


outgoing_str = "C:\Users\mali16\Desktop\All Data\Div2"
Set SourceFolder = Fobj.GetFolder(outgoing_str)
For Each f In SourceFolder.Files
no_of_files = no_of_files + 1
Next f

str1 = outgoing_str

Set myFolder = Fobj.GetFolder(str1)
i = 2
f = no_of_files

For Each f In myFolder.Files
'If ((Int(Left(f.Name, 4)) = current_year) And (Int(Right(Left(f.Name, 6), 2)) >= current_month)) Then
'f.SearchSubFolders = True
'ThisWorkbook.Sheets("Sheet2").Range("g" & i).Value = (" " & f.Name & " ")
ThisWorkbook.Sheets("Sheet2").Range("A1") = "Filename"
ThisWorkbook.Sheets("Sheet2").Range("b1") = "Datemodified"
ThisWorkbook.Sheets("Sheet2").Range("b" & i).Value = f.DateLastModified
ThisWorkbook.Sheets("Sheet2").Range("a" & i).Value = f.Name
'ThisWorkbook.Sheets("Sheet3").Range("d" & I).Value = f.Size
i = i + 1
'End If

Next

Sheet2.Select
Sheet2.Range("A2:B" & Range("B65000").End(xlUp).Row).Copy
Sheet2.Range("E" & Range("E65000").End(xlUp).Row + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlFormats
Sheet2.Range("E:F").EntireColumn.AutoFit


End Sub

Division	FileName	Date Modified	P2	P3	DB	BB
Div1	Book1		'=COUNTIF('C:\Users\pc on user\Desktop\Excel Files\Div1\Exported\[Book1.xlsx]Sheet1'!$A$2:$A$6,"P2")	'=COUNTIF('C:\Users\pc on user\Desktop\Excel Files\Div1\Exported\[Book1.xlsx]Sheet1'!$A$2:$A$6,"P3")	'=COUNTIF('C:\Users\pc on user\Desktop\Excel Files\Div1\Exported\[Book1.xlsx]Sheet2'!$A$2:$A$6,"DB")	'=COUNTIF('C:\Users\pc on user\Desktop\Excel Files\Div1\Exported\[Book1.xlsx]Sheet2'!$A$2:$A$6,"BB")
	Book2		'=COUNTIF('C:\Users\pc on user\Desktop\Excel Files\Div1\Exported\[Book2.xlsx]Sheet1'!$A$2:$A$6,"P2")	'=COUNTIF('C:\Users\pc on user\Desktop\Excel Files\Div1\Exported\[Book2.xlsx]Sheet1'!$A$2:$A$6,"P3")	'=COUNTIF('C:\Users\pc on user\Desktop\Excel Files\Div1\Exported\[Book2.xlsx]Sheet2'!$A$2:$A$6,"DB")	'=COUNTIF('C:\Users\pc on user\Desktop\Excel Files\Div1\Exported\[Book2.xlsx]Sheet2'!$A$2:$A$6,"BB")
Div2	Book4		'=COUNTIF('C:\Users\pc on user\Desktop\Excel Files\Div2\Exported\[Book4.xlsx]Sheet1'!$A$2:$A$6,"P2")	'=COUNTIF('C:\Users\pc on user\Desktop\Excel Files\Div2\Exported\[Book4.xlsx]Sheet1'!$A$2:$A$6,"P3")	'=COUNTIF('C:\Users\pc on user\Desktop\Excel Files\Div2\Exported\[Book4.xlsx]Sheet2'!$A$2:$A$6,"DB")	'=COUNTIF('C:\Users\pc on user\Desktop\Excel Files\Div2\Exported\[Book4.xlsx]Sheet2'!$A$2:$A$6,"BB")

<tbody>
</tbody>

 

[Rijnsent]

Hi Ali,

Hope this bit of code helps you (untested, you'll have to fiddle a bit with it). If you have more code for the forum to look at, please do use [CODE][/CODE] around it.

Set ResWb = ThisWorkbook
Set ResSht = ResWb.Worksheets("Sheet2")
ResSht.Range("A1") = "Filename"
ResSht.Range("b1") = "Datemodified"

For Each f In myFolder.Files
    ResSht.Range("b" & i).Value = f.DateLastModified
    ResSht.Range("a" & i).Value = f.Name
    'Check if Excel file
    If InStr(f.Name, ".xls") > 0 Then
        'Set variable equal to opened workbook
        Set Wb2 = Workbooks.Open(Filename:=outgoing_str & "\" & f.Name)
        Set Wb2Sht = ActiveSheet
        'Ensure Workbook has opened before moving on to next line of code
        DoEvents
        ResSht.Range("C" & i).Value = Application.WorksheetFunction.CountIf(Wb2Sht.Range("A2:A6"), "P2")
        ResSht.Range("D" & i).Value = Application.WorksheetFunction.CountIf(Wb2Sht.Range("A2:A6"), "P3")
        'Close Workbook
        Wb2.Close SaveChanges:=False
        'Ensure Workbook has closed before moving on to next line of code
        DoEvents
    End If
    i = i + 1
Next

Cheers,
Koen

 

[Ali_1984]

Hi Rijnsent,

This is Ali here from FORUM.

Thanks allot for sending code, but i have doubt in that? Should i remove my code which i mentioned in the forum or i need to add your code in that?

If i need to add in my code, then where should i add? can you please guide me or else just combine the both the codes and send me again.

Sorry for troubling you friend.

I am waiting for your reply.

Thanks & Regards
Ali