Como registrar data e hora automaticamente quando a célula muda?
É fácil para nós inserir data e hora estáticas manualmente ou inserir uma data dinâmica que muda com a hora do sistema com uma fórmula. Se você deseja registrar a data e a hora automaticamente ao alterar ou inserir valores, pode ser um pouco diferente para lidar com este problema. Mas, neste artigo, você pode resolver essa tarefa com as etapas a seguir.
O Kutools for Excel resolve a maioria dos seus problemas e aumenta sua produtividade em 80%
Reutilizar qualquer coisa: Adicione as fórmulas, gráficos e tudo mais usados ou complexos aos seus favoritos e reutilize-os rapidamente no futuro.
Mais de 20 recursos de texto: Extrair número da string de texto; Extraia ou remova parte dos textos; Converta números e moedas para palavras em inglês.
Ferramentas de mesclagem: Várias pastas de trabalho e planilhas em um; Mesclar várias células / linhas / colunas sem perder dados; Mesclar linhas duplicadas e soma.
Ferramentas de divisão: Divida os dados em várias folhas com base no valor; Uma pasta de trabalho para vários arquivos do Excel, PDF ou CSV; Uma coluna para várias colunas.
Paste Skipping Linhas ocultas / filtradas; Contagem e soma por cor de fundo; Envie emails personalizados para vários destinatários em massa.
Super Filtro: Crie esquemas de filtro avançados e aplique a qualquer planilha; tipo por semana, dia, frequência e muito mais; filtros por negrito, fórmulas, comentário ...
Mais de 300 recursos poderosos; Funciona com Office 2007-2019 e 365; Suporta todos os idiomas; Fácil implantação em sua empresa ou organização.
Por exemplo, eu tenho um intervalo de valores e agora, quando eu alterar ou digitar novos valores na Coluna B, quero que registre automaticamente a data e a hora atuais na Coluna C como mostrado a seguir:
Você pode terminar esta tarefa com o seguinte código VBA. Por favor, faça o seguinte:
1. Segure o ALT + F11 chaves para abrir o Janela Microsoft Visual Basic for Applications.
2. Em seguida, escolha a planilha usada à esquerda Explorador de Projetos, clique duas vezes para abrir o Móduloe, em seguida, copie e cole o seguinte código VBA no módulo em branco:
Código VBA: registra data e hora automaticamente quando a célula muda
Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
3. Em seguida, salve e feche este código para retornar à planilha, agora quando você alterar o valor da célula ou digitar novos dados na Coluna B, a data e a hora serão registradas automaticamente na Coluna C.
notas:
1. No código acima, você pode modificar o “B: B”Para qualquer outra coluna em que você deseja alterar os valores das células neste script: Defina WorkRng = Intersect (Application.ActiveSheet.Range ("B: B"), Destino).
2. Com isso xOffsetColumn = 1script, você pode inserir e atualizar a data e hora para a primeira coluna ao lado de sua coluna de valor de alteração, você pode alterar o número 1 para outros números, como 2,3,4,5 ... isso significa que a data será inserida no segunda, terceira, quarta ou quinta coluna além da coluna de valores alterados.
3. Ao excluir um valor na coluna alterada, a data e a hora também serão removidas.
As melhores ferramentas de produtividade para escritório
O Kutools for Excel resolve a maioria dos seus problemas e aumenta sua produtividade em 80%
armadilha para peixes: Insira rapidamente fórmulas complexas, gráficos e qualquer coisa que você tenha usado antes; Criptografar células com senha; Criar lista de discussão e enviar emails ...
Super Formula Bar (edite facilmente várias linhas de texto e fórmula); Layout de leitura (ler e editar facilmente um grande número de células); Colar na faixa filtrada...
Mesclar células / linhas / colunas sem perder dados; Dividir o conteúdo das células; Combinar linhas / colunas duplicadas... Evite células duplicadas; Comparar intervalos...
Selecione Duplicado ou Único Linhas; Selecione linhas em branco (todas as células estão vazias); Super Find e Fuzzy Find em muitos livros; Seleção aleatória ...
Cópia exata Várias células sem alterar a referência da fórmula; Criação automática de referências para várias folhas; Inserir marcadores, Caixas de seleção e mais ...
Extrair Texto, Adicionar texto, remover por posição, Remover Espaço; Criar e imprimir subtotais de paginação; Converter entre conteúdo de células e comentários...
Super Filtro (salvar e aplicar esquemas de filtro a outras planilhas); Classificação Avançada por mês / semana / dia, frequência e mais; Filtro Especial por negrito, itálico ...
Combine pastas de trabalho e planilhas; Mesclar tabelas com base em colunas-chave; Divida os dados em várias folhas; Conversão em lote de xls, xlsx e PDF...
Mais de 300 recursos poderosos. Suporta Office / Excel 2007-2019 e 365. Suporta todos os idiomas. Fácil implantação em sua empresa ou organização. Teste gratuito de 30 dias com recursos completos. Garantia de devolução do dinheiro em 60 dias.
I see a couple of people asking about formulas and I'm sorry if I missed the answer somewhere in the thread.
I am updating very large data sets that then are migrated to hidden sheets.
I have those sheets each set with this "latest update" code but since everything on those sheets references back to the larger data set, it does not see a cell update as the formulas remain the same even thought the values change.
I need it to update when the value changes and not jus when the content of the cell changes.
Private Sub Worksheet_Change(ByVal Target As Range) 'Update 20140722 Dim WorkRng As Range Dim Rng As Range Dim xOffsetColumn As Integer Set WorkRng = Intersect(Application.ActiveSheet.Range("A:A"), Target) xOffsetColumn = 1 If Not WorkRng Is Nothing Then Application.EnableEvents = False For Each Rng In WorkRng If Not VBA.IsEmpty(Rng.Value) Then Rng.Offset(0, xOffsetColumn).Value = Now Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss" Else Rng.Offset(0, xOffsetColumn).ClearContents End If Next Application.EnableEvents = True End If End Sub
Private Sub Worksheet_Change(ByVal Target As Range) 'Update 20140722 Dim WorkRng As Range Dim Rng As Range Dim xOffsetColumn As Integer Set WorkRng = Intersect(Application.ActiveSheet.Range("J:J"), Target) xOffsetColumn = 1 If Not WorkRng Is Nothing Then Application.EnableEvents = False For Each Rng In WorkRng If Not VBA.IsEmpty(Rng.Value) Then Rng.Offset(0, xOffsetColumn).Value = Now Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss" Else Rng.Offset(0, xOffsetColumn).ClearContents End If Next Application.EnableEvents = True End If xOffsetColumn = 2 If Not WorkRng Is Nothing Then Application.EnableEvents = False For Each Rng In WorkRng If Not VBA.IsEmpty(Rng.Value) Then Rng.Offset(0, xOffsetColumn).Value = Now Rng.Offset(0, xOffsetColumn).NumberFormat = "hh:mm:ss" Else Rng.Offset(0, xOffsetColumn).ClearContents End If Next Application.EnableEvents = True End If End Sub
If i were to have 2 columns duplicating the same macros, how can that be possible.
I want to show the date and time in column B for values changed in A; while also wanting to show the time and date in column D for values changed in C.
I am a beginner , i had this problem which i saw some of your faced.
This was the situation
For e.g
You want your date and time shown in Column A when any other column of the same row B:AZ for example got their values changed.
So heres my solution. Please correct me if the code has any issues. TIA.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range Dim Rng As Range Dim xOffsetColumn As Integer Set WorkRng = Intersect(Application.ActiveSheet.Range("B:AZ"), Target)'B:AZ put your own columns
'rownumber=Activecell.Row will not work because it it will locate the adjacent row after you press enter or when ur mouse click on other cells rownumber = Target.Row If Not WorkRng Is Nothing Then Application.EnableEvents = False For Each Rng In WorkRng If Not VBA.IsEmpty(Rng.Value) Then Range("A" & rownumber).Value = Now 'gives A and the adjacent row number Range("A" & rownumber).NumberFormat = "dd-mm-yyyy, hh:mm:ss" End If Next Application.EnableEvents = True End If End Sub
Hi All, There had been questions from many including me trying to make any changed cell from for e.g columns B to AZ reflect the date and time at column A for example. Here's my solution. Btw, i am only a beginner. If you find that my solution is wrong, please correct me. Thank you in advance. Refer below:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range Dim Rng As Range Dim xOffsetColumn As Integer Set WorkRng = Intersect(Application.ActiveSheet.Range("B:AZ"), Target) 'this will be your full range of the whole table. 'why Target because you are selecting the current cell, if you use Activecell.Row, you will see the dates appear adjacent to the cell you entered or where your mouse had clicked< i got stuck here real bad'
rownumber = Target.Row If Not WorkRng Is Nothing Then Application.EnableEvents = False For Each Rng In WorkRng If Not VBA.IsEmpty(Rng.Value) Then Range("A" & rownumber).Value = Now Range("A" & rownumber).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
End If Next Application.EnableEvents = True End If End Sub
Hope it helps. Thanks extendoffice genius for guiding me throughout :)
Dear sir Here I need your help. As I want to change any of the cells (B2 to M2) then shows the date and time in A2, can we do this kind of formula ? How can we do ?
How do i apply this code if i only want the time stamp to change if a specific value is entered, So i only wnat it to record the date when I select green from a drop down?
What if I want to save data in a single cell that is updated daily with the current date and time?
Example:
I have a transaction balance that changes every day on Cell D2
I want the data to be in Cell B2 (Today). The next day I want Cell D2 when there is a change, I want the data to automatically be in Cell B3 (H + 1) without experiencing changes to Cell B2
The code in "VBA code: Record date and time automatically when cell changes" above works well in my worksheet where I manually enter data in a cell. However, I have a "summary" worksheet in which cells automatically update their value based upon the values of cells on other worksheets in the same workbook, e.g. The formula in my cell B6 on my 'summary' worksheet might be ='Example'!F3. When the value in 'Example!F3 changes the summary sheet cell B6 automatically updates to a new value. I am trying to show a timestamp on the summary sheet when ever changes occur to save me having to search through numerous linked worksheet for changes. With the present VBA code nothing happens when the value on my 'summary' sheet updates from the data on the linked worksheet cells. Can you help with this please?
Would it be possible to have the timestamp appear 5 rows down? Would need it in an specific cell and not the entire column.
Column range is easy to change to specific cell but i don´t know how to get the timestamp in an specific cell :(
Please help!
Would it be possible to change on what row the timestamp is showed? I would like to have the timestamp 5 rows down.
Tried xOffsetRows = 5 but that did not word, maybe that command does not exist :)
Please help!
what about if i need to have column I, J, and K all trigger a date into column L? I have tried posting script 3 times, and changing the name, and column offset, but it never runs the second and third script.
I am attempting to make this reference multiple columns and reflect the date of any change in these columns back to one column. example, if i change anything in I,J,or K I want the date updated to current in L. i have tried to copy this VB code 3 times, changing the target, and column application to be I:I and 3 J:J and 2, K:K and 1. only K:K will work to change L. thoughts?
Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("I:I"), Target)
xOffsetColumn = -3
If Not WorkRng Is Nothing Then Application.EnableEvents = False
For Each Rng In WorkRng If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
Else Rng.Offset(0, xOffsetColumn).ClearContents
End If Next
Application.EnableEvents = True
End If
Set WorkRng = Intersect(Application.ActiveSheet.Range("I:I"), Target)
xOffsetColumn = -5
If Not WorkRng Is Nothing Then Application.EnableEvents = False
For Each Rng In WorkRng If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mmm-yyyy"
Else Rng.Offset(0, xOffsetColumn).ClearContents
End If Next
Application.EnableEvents = True
End If Dim xRg As Range
On Error Resume Next Set xRg = Intersect(Range("A:O"), Target)
If xRg Is Nothing Then Exit Sub Target.Worksheet.Unprotect Password:="123"
If xRg.Value <> mStr Then xRg.Locked = True Target.Worksheet.Protect Password:="123"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("I:I"), Target)
xOffsetColumn = -3
If Not WorkRng Is Nothing Then Application.EnableEvents = False
For Each Rng In WorkRng If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now Rng.Offset(0, xOffsetColumn).NumberFormat = "hh:mm:ss"
Else Rng.Offset(0, xOffsetColumn).ClearContents
End If Next
Application.EnableEvents = True
End If
Set WorkRng = Intersect(Application.ActiveSheet.Range("I:I"), Target)
xOffsetColumn = -5
If Not WorkRng Is Nothing Then Application.EnableEvents = False
For Each Rng In WorkRng If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mmm-yyyy"
Else Rng.Offset(0, xOffsetColumn).ClearContents
End If Next
Application.EnableEvents = True
End If Dim xRg As Range
On Error Resume Next Set xRg = Intersect(Range("A:O"), Target)
If xRg Is Nothing Then Exit Sub Target.Worksheet.Unprotect Password:="123"
If xRg.Value <> mStr Then xRg.Locked = True Target.Worksheet.Protect Password:="123"
End Sub
This is exactly what I needed. Since I needed a timestamp in column F to reflect any changes in columns A, B, C, D, or E in a row, I duplicated the code that many times and redefined the range to point to each of the columns within the different iterations of the code.
Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("A:A"), Target)
xOffsetColumn = 5
If Not WorkRng Is Nothing Then Application.EnableEvents = False
For Each Rng In WorkRng If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
Else Rng.Offset(0, xOffsetColumn).ClearContents
End If Next
Application.EnableEvents = True
End If
Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
xOffsetColumn = 4
If Not WorkRng Is Nothing Then Application.EnableEvents = False
For Each Rng In WorkRng If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
Else Rng.Offset(0, xOffsetColumn).ClearContents
End If Next
Application.EnableEvents = True
End If
Hi Chris, I see you posted the exact answer to my previous question already. I just had to expand the reading area. My bad. Thank you so much for your post. This has been so helpful.
Hi Chris, Can you let me know what part of the code I should copy and also where to paste it? I'm trying the same but am getting error codes. Preferably I would like to get a timestamp in Column F to reflect a change in Column A, and a timestamp in Column G to reflect a change in Column B. But one timestamp for a change in column A, B, C, D, or E like you did would already be great. Many thanks for your help.
Also, I have to say: Your instructions are THE BEST, so simple but effective and straight forward!!!
by simply adding Rng.Offset(0, yOffsetColumn).Value = Environ$("UserName")
above Else in the next column I am capturing the Windows Username as well, I didn't need a full Audit Trail and wanted the Change info WITH the data, this is perfect.
I was wondering how would you modify the code to fill in the date only if you wanted it to populate for a given value. Say I only want the date to populate when I select "Closed" for a value for the target range?
what can i do if i need to add another range in same sheet
when i fill in column A reflect date & time in column B and when filling in column C reflect date & time in column D
and when i clear the content of column A or C it clear B or D too
What if i need to another range in same sheet?
When i fill in column A reflect date&time in column B and when i fill in column C reflect date&time in column D
and when i clear of any column A or C it clear B & D
Set rInt = Intersect(Target, Range("A2:D43415")) 'Change cell range
If Not rInt Is Nothing Then For Each rCell In rInt
Set tCell = Cells(rCell.Cells.Row, tColInt) If IsEmpty(tCell) Or Not IsEmpty(tCell) Then
tCell = Now tCell.NumberFormat = "dd/mm/yyyy h:mm:ss AM/PM" 'Custom Format
End If Next
End If
End Sub
example
Set WorkRng = Intersect(Application.ActiveSheet.Range("E:E,F:F,G:G,H:H"), Target)
xOffsetColumn = 8
i want any entry change in column E, F, G, H then date can stamp column M
Hi all, the code is working fine but i does not work when the worksheet is protected. although I have unprotected the column the certain column for the timestamp is. i am attaching the error message pop up. please help.
Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then Application.EnableEvents = False
For Each Rng In WorkRng If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
Else Rng.Offset(0, xOffsetColumn).ClearContents
End If Next
Application.EnableEvents = True
End If
End Sub
You can unlock the sheet before and after the if to make it work:
Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("A:A"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
ActiveSheet.Unprotect
Application.EnableEvents = False
For Each Rng In WorkRng If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now Rng.Offset(0, xOffsetColumn).NumberFormat = "hh:mm"
Else Rng.Offset(0, xOffsetColumn).ClearContents
End If Next
Application.EnableEvents = True
i use the code given and it works perfectly. but it does not working whenever the sheet is locked, although, i already unlocked the column form the time stamp is. can you help? thank you in advance.
Every thing is perfect ...every time i save the script but when i close the application and reopen it the script does not work and i need to write/copy it again.
thanx
Every thing is perfect ...every time i save the script but when i close the application and reopen it the script does not work and i need to write/copy it again.
thanx
Is it possible to implement this code with the data refresh. Because when i refresh the data it always puts the now stamp, however when the data is changed manually it does it okay and only records when manually changed correctly so all the times are then different, but when refreshed it might create new rows and therefore it puts all the current timestamps.
How do I get this code to put the date stamp in the column to the left? I tried -1 and it didn't work. Also, it doesn't seem to recognize data filled in by a formula. Can I do that? I need this for twelve different columns in one Summary sheet that gathers data from six departmental sheets. Any help would be greatly appreciated.
Hi, Can anyone one suggest a code for when I input number in column A and Column B and in Column C I kept a formula like Column A + Column B. Now I need a vba code that can give time and date in Column D whenever Column C changes not when inserting numbers in Column A and B.
Hi,
the code runs perfectly, this is what I was searching for. One little update / help needed:
I have the data in column B, the time is in column AA, and have another data in column A. It would be great if you could modify the code, so it will run only if the values in B and A are matching.
Hello there,
Update the original code with that.
In the meanwhile I have put another IF statement update before the code " If Rng.Offset(0, 1).Value = 0 Then ", because whenever you delete an upper row, it will cause cell value change, an will stamp the time again.
If Rng.Offset(0, 1).Value = 0 Then If Not VBA.IsEmpty(Rng.Value) And Rng.Offset(0, -1).Value = Rng.Offset(0, 0).Value Then
Hi,
the code works perfectly, this is what I was searching for. Thanks.
One more little help / update about the code. I have the data in column B, the date+time is in AA, and another data in column A. Can you please help to modify the code, so it will run only if value in B and A is the same.
I am having trouble getting the code to do what I want and think I am missing a step.
I have a spreadsheet that I would like TODAY returned into Column N whenever an "X" is placed in either Column O or P, and return to blank if that "X" is deleted. What am I missing in code that will allow me to have that happen?
Tried code. Worked perfect in normal cases. But i need it little more advanced.
I need the time & date populated in column F; keeping the columns from A to E uneditable.
Can you help?
