VBA: Finding value defined by formula in range.

[Satamanster]

Hello everyone. I'm trying to create a tool to copy the times my employees set on their log and paste them on a separe sheet the company used to log everyone's times.

I managed to have the code 95% to how I want it to be. One thing is missing... Actually making it work...

So I've used the rest of the code to process the data inside the daily log, add the times for people who sign in multiple times, etc. I have one and one problem only.

When I open the sheet that I use to track the log for some reason the value I pass on with a variable is not being found in the specefied range. If I look manually (with a Ctrl + F) I can find it. And I can see the code is opening the appropriate sheet. But then it can't find nor the corresponding date or the employee's initials.

I'm not uploading the entire code, just the portion that is not working as intended. Maybe you can figure out something I'm missing.....

    Dim varA As String
    Dim varB As String
    Dim varC As String
    Dim foundRngD As Range
    Dim foundRngN As Range
    WB1.Activate
    With Sheets("Temp Sheet")
        LastRow = .Range("C" & Rows.Count).End(xlUp).Row
            For r = LastRow To 1 Step -1
                
                varA = .Cells(r, 1) ' Emplyee Position
                varB = .Cells(r, 2) ' Employee Name
                varC = .Cells(r, 3) ' Time in Position in minutes
                
                WB2.Activate
                Worksheets(varA).Select
                
            ' Find the row corresponding the log's Date.
                
                With Worksheets(varA).Range("A1:A551")
                    Set foundRngD = .Find(What:=ProtimeDate, LookIn:=xlValues)
                End With

                If foundRngD Is Nothing Then
                    MsgBox "Data " & LogDate & " not available in sheet " & varA & ".", vbCritical
                Else
                    MsgBox foundRngD.Address
                End If
                                
            ' Search for the appropriate column with employee Initials.
                
                With Worksheets(varA).Range("A1:F1")
                    Set foundRngN = .Find(What:=varB, LookIn:=xlValues)
                End With

                If foundRngN Is Nothing Then
                    MsgBox "Initials" & varB & " not found on sheet " & varA & ".", vbCritical
                Else
                    MsgBox foundRngN.Address
                End If
 
            Next r
                WB1.Activate
    End With

In all seriousness I've looked up many ways to solve it but I can't get my way around it. May I had that the code is working as I'm getting msgBoxes stating that the value could not be found.

I'd be really glad if someone was able to help out!

 

[dmt32]

Hi,

Range.Find Method can be a bit of a problem when searching for dates but is normally doable

Problem with sharing just portion of your code is that doing this often leaves out information forum needs to understand to assist – in this case the Variable ProtimeDate you are using for the search?

• What data type is it declared as (String, Long, Date, Variant)? & Where in your code is it initialized?
• are the date values in the Range real or string dates?
• Your Msgbox reports using another variable LogDate if the Search value is not found? So just wonder, are you using the correct variable to perform the search?

I had a quick play & made some changes to your posted code & managed get it to Find a real date using today’s date in worksheets(varA) of the same workbook which you may be able to use to amend your project. If though, you still have issues, can I suggest that you post all your code & also attach copy of your worksheet (with dummy data) using

MrExcel Addin :XL2BB - Excel Range to BBCode

Plenty of forum here who should be able to assist.

Hope Helpful

Dave

Sub Satamanster()
    Dim varA        As String
    Dim varB        As String
    Dim varC        As String
    Dim foundRngD   As Range
    Dim foundRngN   As Range
 
    Dim wsTempSheet As Worksheet
 
    Set wsTempSheet = ThisWorkbook.Worksheets("Temp Sheet")
 
    'testing only
    Dim ProtimeDate As Date
    ProtimeDate = Date
 
    With wsTempSheet
        LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
        For r = LastRow To 1 Step -1
         
            varA = .Cells(r, 1)        ' Emplyee Position
            varB = .Cells(r, 2)        ' Employee Name
            varC = .Cells(r, 3)        ' Time in Position in minutes
         
            ' Find the row corresponding the log's Date.
         
            Set foundRngD = Worksheets(varA).Range("A1:A551").Find(What:=ProtimeDate, _
                                                                    LookIn:=xlValues, LookAt:=xlWhole)
            If foundRngD Is Nothing Then
                MsgBox "Data " & LogDate & " Not available in sheet " & varA & ".", vbCritical
                Exit Sub
            Else
                MsgBox foundRngD.Address
            End If
         
            ' Search for the appropriate column with employee Initials.
         
            Set foundRngN = Worksheets(varA).Range("A1:F1").Find(What:=varB, _
                                                                 LookIn:=xlValues, LookAt:=xlWhole)
         
            If foundRngN Is Nothing Then
                MsgBox "Initials" & varB & " Not found On sheet " & varA & ".", vbCritical
            Else
                MsgBox foundRngN.Address
            End If
         
        Next r
    End With
End Sub

 

[Satamanster]

Unfortunately I haven't been able to figure out the solution for it... With regards to operator's initials that was all a range matter, stupid me confused "F" column with "FF" column...

But date.. ****, i haven't been able to figure that out.

Here's the full code (Comments are in Portuguese sorry)

'************************************
'        PROTIME Automático
' Programado por: TEN Nuno Álvares
' Versão Original: 09 Maio 2022
' Última Atualização: 09 Maio 2022
'************************************

' Define variáveis globais do tipo workbook para trabalhar mais tarde com ambos os ficheiros (relatório e protime)

    Dim WB1 As Workbook
    Dim WB2 As Workbook
    Dim ProtimeDate As Date

Sub PROTIME()

' Define WB1 como o ficheiro ativo (relatório).

Set WB1 = ActiveWorkbook

' Verifica se o ficheiro em utilização é de facto um ficheiro de relatório e se for copia a data do mesmo para uma variável.

    If Range("E8").Value = "RELATÓRIO DIÁRIO DOS SERVIÇOS DE TRÁFEGO AÉREO" Then
    ProtimeDate = Range("J13").Value
    MsgBox ProtimeDate
    

' Desbloqueia o ficheiro LOG para poder utilizá-lo no restante processo.

        ActiveSheet.Unprotect Password:="log2018c"
        MsgBox "O ficheiro corrente corresponde a um ficheiro de relatório válido. Clique em OK para continuar."
        
' Carrega a sub "OrganizaDados" que organiza os dados numa tabela externa.
    
        OrganizaDados
        
' Carrega a sub "ColaProTime" que copia os dados da tabela organizada para o ficheiro de ProTime
    
        ColaProtime
    
' Bloqueia o ficheiro LOG após concluir or processo.
    
        ActiveSheet.Protect Password:="log2018c", DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingRows:=True
        Exit Sub

' Se o ficheiro não for um relatório válido, é mostrada uma mensagem de erro e o código encerra.
    
    Else
                
        MsgBox "O ficheiro corrente não corresponde a um ficheiro de relatório válido. Por favor selecione um ficheiro de relatório válido. Clique em OK para sair."
        Exit Sub
        
    End If

End Sub
Sub OrganizaDados()

' Bloqueia o refrescamento do ecrã durante a organização dos dados.

    Application.ScreenUpdating = False

' Recolhe o nome da folha atual e atribui-o a umavariável para viabilizar a utilização da macro para a folha de torre e aproximação.
    
    Dim logSheet As Worksheet
    Set logSheet = ActiveSheet

' Cria uma sheet de trabalho adicional para poder trabalhar os dados

    Sheets.Add.Name = "Temp Sheet"
    
' Copia os dados do relatório e cola-os na nova tabela.

    logSheet.Select
    Range("B36:C55").Select
    Selection.Copy
    Sheets("Temp Sheet").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    logSheet.Select
    Range("N36:N55").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp Sheet").Select
    Range("A21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    logSheet.Select
    Range("H36:I55").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp Sheet").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    logSheet.Select
    Range("R36:U55").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp Sheet").Select
    Range("B21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    logSheet.Select
    Range("J36:L55").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp Sheet").Select
    Range("C1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    logSheet.Select
    ActiveWindow.SmallScroll Down:=6
    Range("V36:Y55").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp Sheet").Select
    Range("C21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

' Coloca as posições na coluna A e os operadores na coluna B.
    
    Columns("B:B").Select
    Selection.Cut
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    
' Apaga as linhas onde o número de minutos é igual a zero.

    With Sheets("Temp Sheet")
    LastRow = .Range("C" & Rows.Count).End(xlUp).Row
        For r = LastRow To 1 Step -1
            If .Cells(r, "C") = 0 Then .Cells(r, "C").EntireRow.Delete
        Next r
    End With
    
' Organiza as linhas por posição e por operador.

    Range("A1:C40").Sort Key1:=Range("A1:A40"), Key2:=Range("B1:B40")

' Soma os tempos para posição e operador iguais

    Dim var1 As String
    Dim var2 As String
    
    With Sheets("Temp Sheet")
        LastRow = .Range("C" & Rows.Count).End(xlUp).Row
            For r = LastRow To 2 Step -1
                var1 = .Cells(r, 1) & .Cells(r, 2)
                var2 = .Cells(r - 1, 1) & .Cells(r - 1, 2)
                If var2 = var1 Then
                    .Cells(r - 1, 3) = .Cells(r - 1, 3) + .Cells(r, 3)
                    .Cells(r, 3).EntireRow.Delete
                End If
            Next r
    End With
    
' Remove a designação 'OJT' das posições para introduzir os OJTs na tabela apropriada.

    Range("A1:A40").Select
    Selection.Replace What:="/OJT", Replacement:=""
    
' Muda os nomes para que fiquem iguais ao ficheiro de ProTime.

    Range("A1:A40").Select
    Selection.Replace What:="ADI CD/TI", Replacement:="ADI_CD_OJTI"
    Selection.Replace What:="ADI TWR/TI", Replacement:="ADI_TWR_OJTI"
    Selection.Replace What:="ADI CD", Replacement:="ADI_CD"
    Selection.Replace What:="ADI SUP", Replacement:="ADI_SUP"
    Selection.Replace What:="ADI TWR", Replacement:="ADI_TWR"
    
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    
' Regressa ao ficheiro de relatório e recupera o refrescamento do ecrã.
    
    logSheet.Select

    
End Sub

Sub ColaProtime()

' Abre o ficheiro de Protime a partir da localização e nome default.
' Se a localização / nome não corresponder a um ficheiro válido é pedido ao utilizador que selecione o ficheiro correspondente.

Dim strFile As String
Dim strFileExists As String
 
    strFile = "\\riba4-admin01\dept\RIBA4\GO\ETA\0-Geral EAD\PTME_TEST.xlsm" ' **** MUDAR O DIRETÓRIO DO FICHEIRO PROTIME AQUI!!! ***
    strFileExists = Dir(strFile)
 
   If strFileExists = "" Then
        
        MsgBox "Não foi possível localizar o ficheiro. " & vbNewLine & "Selecione o ficheiro ProTime correspondente.", vbCritical
        Dim strFile1 As String
        strFile1 = Application.GetOpenFilename()
        Workbooks.Open (strFile1)
        Set WB2 = ActiveWorkbook  ' Define WB2 como o ficheiro ativo (protime).
        
    Else
        
        Workbooks.Open (strFile)
        Set WB2 = ActiveWorkbook  ' Define WB2 como o ficheiro ativo (protime).
        
    End If
'**************************************************************************************

' Copia os dados da tabela anexa para o ficheiro de ProTime

    Dim varA As String
    Dim varB As String
    Dim varC As String
    Dim foundRngD As Range
    Dim foundRngN As Range
    
    WB1.Activate
    
    With Sheets("Temp Sheet")
        LastRow = .Range("C" & Rows.Count).End(xlUp).Row
            For r = LastRow To 1 Step -1
                
                varA = .Cells(r, 1) ' Posição
                varB = .Cells(r, 2) ' Operador
                varC = .Cells(r, 3) ' Tempo em minutos
                
                WB2.Activate
                Worksheets(varA).Select
                
            ' Procura a linha correspondente à data.
                
                With Worksheets(varA).Range("A1:A551")
                    'Set foundRngD = .Find(What:=ProtimeDate, LookIn:=xlValues, LookAt:=xlWhole)
                End With

                If foundRngD Is Nothing Then
                    MsgBox "Data " & ProtimeDate & " não disponível na folha " & varA & ".", vbCritical
                Else
                    MsgBox foundRngD.Address
                End If
                                
            ' Procura a coluna correspondente ao nome.
                
                With Worksheets(varA).Range("A1:FF1")
                    Set foundRngN = .Find(What:=varB, LookIn:=xlValues)
                End With

                If foundRngN Is Nothing Then
                    MsgBox "Iniciais " & varB & " não encontradas na folha " & varA & ".", vbCritical
                Else
                    MsgBox "Iniciais " & varB & " encontradas na folha " & varA & " no endereço: " & foundRngN.Address
                End If
                
            ' Cola o valor do protime na célula correspondente.
            
                If foundRngN Is Nothing Or foundRngD Is Nothing Then
                    MsgBox "As iniciais " & varB & " não vão ser introduzidas." & vbNewLine & vbNewLine & "A passar para o próximo registo."
                Else
                    Cells(foundRngD.Row, foundRngN.Column).Value = varC
                End If
            
            
            Next r
                WB1.Activate
    End With

'**************************************************************************************
' Guarda o ficheiro de ProTime

    WB2.Save

' Após concluído o processo volta a abrir o relatório e é dada uma indicação de sucesso ao operador.

    WB1.Activate
    Application.DisplayAlerts = False
    Worksheets("Temp Sheet").Delete
    Application.DisplayAlerts = True
    ActiveWindow.ScrollRow = 1
    Application.ScreenUpdating = True
    MsgBox "O ProTime para o dia de hoje referente a esta facilidade foi copiado com sucesso." & vbNewLine & vbNewLine & "Prima OK para concluir.", vbInformation
    
End Sub

Right now, the only thing that it's not working is really just finding out the date. Everything else is good...

If needed here you have access to a sample LOG and the PROTime File as it currently is.

Sample Daily Log:

12MAY22TWR.xlsm

drive.google.com

Protime File:

PTME_TEST.xlsm

drive.google.com

Hopefully someone will be able to enlight me.

Thanks you in advance... This automation would save us nearly 130 hours of manpower.