Find and copy based on cell values VBA

[kamalm]

Hi, I have multiple values along the Column E. Some of them are "ALARM". Each of the "ALARM" values have their own date and time at the Column B and C respectively but at the row before the "ALARM" values. I inserted sample at the table below:

A	B	C	D	E	F	G	H	I
1
2
3	24/05/2018	12:17:43
4				ALARM
5
6
7	24/05/2018	12:18:55
8				ALARM
9
10
11
12	24/05/2018	12:20:22
13				ALARM
14
15

<tbody>
</tbody>

i need macro that can copy the date to Column G while time to Column H, same row with "ALARM" values. The outcome should be like this:

A	B	C	D	E	F	G	H	I
1
2
3	24/05/2018	12:17:43
4				ALARM		24/05/2018	12:17:43
5
6
7	24/05/2018	12:18:55
8				ALARM		24/05/2018	12:18:55
9
10
11
12	24/05/2018	12:20:22
13				ALARM		24/05/2018	12:20:22
14

<tbody>
</tbody>

 

[JoeMo]

Are there any formulas in columns A:E?

 

[kamalm]

Are there any formulas in columns A:E?

No, there is no any formula. I just tried this code and it works. But this code only copy for date. Am I need to repeat the same code for time ?

Sub findalarm()


Dim rcnt As Long
rcnt = Worksheets(2).Range("E" & Rows.Count).End(xlUp).Row
For i = 1 To rcnt
If Range("E" & i).Value = "(ALARM" Then
    Range("E" & i).Offset(-1, -3).Copy
    Range("E" & i).Offset(0, 2).PasteSpecial xlPasteAll
    
    End If
    Next i
    
Application.CutCopyMode = False




End Sub

 

[JoeMo]

Assumes the layout shown in your initial post.

Sub ALARM()
Dim V As Variant, c As Range
Application.ScreenUpdating = False
With Range("A3:E" & Cells(Rows.Count, "E").End(xlUp).Row)
    V = .Value
    .Columns(5).Replace "ALARM", "#N/A"
    On Error Resume Next
    For Each c In .Columns(5).SpecialCells(xlCellTypeConstants, xlErrors)
        c.Offset(0, 2).Resize(, 2).Value = c.Offset(-1, -3).Resize(, 2).Value
    Next c
    On Error GoTo 0
    .Value = V
End With
With Range("G:H")
    .Columns(1).NumberFormat = "dd/mm/yyyy"
    .Columns(2).NumberFormat = "hh:mm:ss"
    .EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
End Sub