VBA - Looping Through worksheets, validate some data, send mails and Copy columns

[Bullstrik1]

Hi all,
Been banging my head against the wall with this one for quite few time now, so i hope you guys could help me with it.

For the discussion sake, let’s say I got a folder of files that I receive in my e-mail periodically and I’m saving them on the folder with the name “Relatorio Telefonia yyyymmdd”, where yyyymmdd is the extended date of the last received information. These files have information of each day of a given month in several sheets (1 sheet per day).
I am trying to write a macro that allows me to do some verification on the recent of these files and I was able to count all non-empty sheets on the workbook. The verifications I want are:

1. Check first row of all non-empty worksheets to see if there is a value named “Statistic”. If there is a sheet with no such value, close the workbook and send a e-mail to someone asking the person to validate/correct the data they sent me;

1. After that first test, its necessary to collect the column number of the cells that contains the word “Statistic” and count all the non-empty values after row 1. If that count is < 18, then close the workbook and send an e-mail asking a person to correct the data he/she sent me;

1. After these 2 tests I want to copy some data to a “master file, but this part I think I can do it on my own and I will not bother u with it :P

The code I have atm is this (Pls note that the code is under construction and is not set in ston. If u have a improvement sugestion, pls dont hesitate in doing it):

Option Explicit




Sub AbreRelatorioTelefonia()
    
Dim Path As String, Name As String
Dim LMD As Variant, MyFile As String, LatestFile As String, LatestDate As Date
Dim c As Long, s As String
Dim n As Integer, i As Integer, R As Variant, LastRow As Long, var As Integer
Dim Rng As Variant, strDate As String, OutApp As Object, OutMail As Object, a As String
Dim b As String, CountS As Integer, ValorAProcurar As Variant
Dim wksht As Worksheet, y As Integer


    
    Path = "C:\Users\Tom\VBA Project"
    
    If Right(Path, 1) <> "\" Then Path = Path & "\"
    
    MyFile = Dir(Path & "*.xlsx", vbNormal)
        
    If Len(MyFile) = 0 Then
        MsgBox "Não foram encontrados ficheiros na pasta.", vbExclamation
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    'Loop through each Excel file in the folder
    Do While Len(MyFile) > 0
    
        'Assign the date/time of the current file to a variable
        LMD = Mid(MyFile, 20, 8)
        
        'If the date/time of the current file is greater than the latest
        'recorded date, assign its filename and date/time to variables
        If LMD > LatestDate Then
            LatestFile = MyFile
            LatestDate = LMD
        End If
        
        'Get the next Excel file from the folder
        MyFile = Dir
        
    Loop
 
'Open the latest file
    Workbooks.Open Path & LatestFile


strDate = Format(Date, "yyyymmdd")
n = Workbooks(LatestFile).Worksheets.count
R = Range("A1:XFD1")
a = "Caros," & vbCrLf & vbCrLf & "Não foi encontrada a coluna com nome Satistic no relatório de telefonia em anexo." & vbCrLf & "Solicitamos que, por favor, rectifiquem a informação que consta no documento e que nos remetam a mesma assim que possível." & vbCrLf & "Obrigado."
b = "Caros," & vbCrLf & vbCrLf & "Existem menos estatísticas que as usuais 18." & vbCrLf & "Solicitamos que, por favor, rectifiquem a informação que consta no documento e que nos remetam a mesma assim que possível." & vbCrLf & "Obrigado."


Workbooks(LatestFile).Activate
Workbooks(LatestFile).Worksheets(1).Select


   For Each wksht In ActiveWorkbook.Worksheets
       
        If Application.WorksheetFunction.CountA(wksht.Cells) = 0 Then CountS = CountS + 1
        
    Next wksht


y = n - CountS
    
i = 1
Do While i < y
With Workbooks(LatestFile).Worksheets(i).R
Set Rng = .Find(what:="Satistic", _
                After:=Cells(1, 1), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
End With
If Rng Is Nothing Then


Workbooks(Path & LatestFile).Close SaveChanges:=False


Set OutApp = CreateObject("Outlook.Application")
    
    Set OutMail = OutApp.CreateItem(0)


 With OutMail
            .To = "nuno-r-gaspar@telecom.pt"
            .CC = "gilberto-m-rego@telecom.pt;joao.pires@manpower.pt "
            .BCC = ""
            .Subject = "Planeamento MGS | PT CONTACT 16200 CONSUMO SNTC (COIMBRA) | P000021 | Relatório Telefonia a Rectificar" & strDate
            .Body = a
            .Attachments.Add (LatestFile)
            ' In place of the following statement, you can use ".Send" to
            ' send the mail.
            .Display
        End With
   
    ' Kill TempFilePath & TempFileName & FileExtStr


    Set OutMail = Nothing
    Set OutApp = Nothing
    
Kill Path & LatestFile


Exit Sub
    
Else
c = Rng.Column
LastRow = Cells(1, c).End(xlUp).Row
var = Cells(LastRow, c).count.xlUp


If var < 18 Then MsgBox "Verificar variáveis no ficheiro de dados"
End If
Loop


Application.ScreenUpdating = True


End Sub

At the moment i'm stuck in the line

With Workbooks(LatestFile).Worksheets(i).R

it retreive me a runtime error message error 438.
Can someone pls help me with this one?

Tkx in advance

 

[storm8]

your code looks good.

this will allow you to manipulate with the object

dim wbk as Workbook
set wbk =  Workbooks.Open Path & LatestFile
...
n = wbk.Worksheets.Count

change all other references

also variant R can be range

dim R as range
set R = nwb.sheets(n).Range("A1:XFD1")

these are unncecessary

Workbooks(LatestFile).Activate
Workbooks(LatestFile).Worksheets(1).Select

loop in workook object
drop Application.

   For Each wksht In wbk.Worksheets
       
        If WorksheetFunction.CountA(wksht.Cells) = 0 Then CountS = CountS + 1
        
    Next wksht

since R is now a range, you can refer to it directly

With R

I think you more or less have the rest

 

[Bullstrik1]

tank you for the feedback storm8. I will surely try all your sugestions tomorrow when i get to work!
Anyway i just have 1 question: since i don't want to look all my worksheets, only the ones whitch are not empty , why is this part of the code retrevieng me a error message?

Do While i < yWith Workbooks(LatestFile).Worksheets(i).RSet Rng = .Find(what:="Satistic", _                After:=Cells(1, 1), _                LookIn:=xlValues, _                LookAt:=xlWhole, _                SearchOrder:=xlByColumns, _                SearchDirection:=xlNext, _                MatchCase:=False)

 

[storm8]

you dont need to reference

With Workbooks(LatestFile).Worksheets(i).R

just reference

.R

 

[Bullstrik1]

you dont need to reference

With Workbooks(LatestFile).Worksheets(i).R

just reference

.R

Hi again,

Oce again, tank you very much for your feedback storm8!
Code tested and working, but not doing exactly what i would like it to do, maybe because i wasn't clear enough in my first explanation, and if that's the case i apologise in advance and i'll try to be more clear and precise this time.

As you can see in this piece of code:

For Each wksht In wbk.Worksheets
       
        If WorksheetFunction.CountA(wksht.Cells) = 0 Then CountS = CountS + 1
        
    Next wksht


y = n - CountS

i defined y as the number of sheets that the code should lookup for the word "Statistic". With the changes i did to the code, acordingly with storm8 suggestion, when the code comes to this part:

i = 1
Do While i < y
With R
Set Rng = .Find(what:="Satistic", _
                After:=Cells(1, 1), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
End With
If Rng Is Nothing Then


wbk.Close SaveChanges:=False


Set OutApp = CreateObject("Outlook.Application")
    
    Set OutMail = OutApp.CreateItem(0)


 With OutMail
            .To = "someone3@gmail.com"
            .CC = "someone1@gmail.com;someone2@gmail.com "
            .BCC = ""
            .Subject = "Planeamento MGS | PT CONTACT 16200 CONSUMO SNTC (COIMBRA) | P000021 | Relatório Telefonia a Rectificar" & strDate
            .Body = a
            .Attachments.Add (wbk.Close)
            ' In place of the following statement, you can use ".Send" to
            ' send the mail.
            .Display
        End With
   
    ' Kill TempFilePath & TempFileName & FileExtStr


    Set OutMail = Nothing
    Set OutApp = Nothing
    
Kill Path & LatestFile


Exit Sub
    
Else
c = Rng.Column
LastRow = Cells(1, c).End(xlUp).Row
var = Cells(LastRow, c).Count.xlUp


If var < 18 Then MsgBox "Verificar variáveis no ficheiro de dados"
End If
Loop

it directly opens outlook. As my first atempt, using Storm8 suggestion, i thought that the code was only searching the word "Statistic" in the nth worksheet since i seted R as suggested:

Set [COLOR=#574123]R = wbk.sheets(n).Range("A1:XFD1")[/COLOR]

. So i changed the code to

Set [COLOR=#574123]R = wbk.sheets(i).Range("A1:XFD1")[/COLOR]

so it goes to all loop phases, but still it didn't work and it goes directly and opens the e-mail.

Does someone have an ideia what to do next in order the code to perform a search over all the 1,2,...,y worksheets and only go to the e-mail if any of these sheets don't have "Statistic" word in it?

Tkx in advance for the help

 

[storm8]

hi,

Im happy to help more but lazy to make the setup. can you send me folder with few files that have structure you expect? Ill test the code and make adjustments.

 

[Bullstrik1]

I managed to make the code work as it should Storm8, tkx for your help.
If i need more help with this i'll let u guys know in here.

Again, tkx a ton for the help.