Adding IF condition in the recorded macro

[svenkat]

In the given macro I want to insert an IF & ELSEIF condition at the aero mark location,

IF B4 is NOT EQUAL TO B5000 then it should continue as it is for next four lines.

ELSEIF B4 IS EQUAL TO B5000 then it should paste on same B4 instead of inserting and paste.

In other words, I want to save the data by inserting new row if the date is different otherwise without inserting paste on same line.

Please help me.

Can I have any link to learn how to insert condition step by step.

__________________________

Sub Macro1()

'

' Macro1 Macro

' Store Data

'

'

Rows("5000:5000").Select

Selection.Copy

Rows("4999:4999").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ScrollRow = 4

Add the if condition

Rows("4:4").Select

Selection.Insert Shift:=xlDown

Rows("6:6").Select

Application.CutCopyMode = False





Selection.Copy

Rows("4:4").Select

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

ActiveWindow.ScrollRow = 4999

Rows("5000:5000").Select

Selection.Delete Shift:=xlUp

Sheets("Manpower").Select

Range("A10").Activate

End Sub

 

[rhratterman15]

Try This:

Sub Macro1()

'

' Macro1 Macro

' Store Data

'

'

Rows("5000:5000").Select

Selection.Copy

Rows("4999:4999").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ScrollRow = 4

'[IMG alt="1589241505112.png"]https://www.mrexcel.com/board/attachments/1589241505112-png.13621/[/IMG]
[U]'Add the if condition[/U]

If Range("B4").Value <> Range("B5000").Value Then

     Rows("4:4").Select

     Selection.Insert Shift:=xlDown

     Rows("6:6").Select

     Application.CutCopyMode = False
End If

If Range("B4").Value = Range("B5000").Value Then
     Selection.Copy

     Rows("4:4").Select

     Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

     SkipBlanks:=False, Transpose:=False

     Application.CutCopyMode = False

     ActiveWindow.ScrollRow = 4999

     Rows("5000:5000").Select

     Selection.Delete Shift:=xlUp

     Sheets("Manpower").Select

     Range("A10").Activate
End If

End Sub

 

[svenkat]

Thanks

 

[svenkat]

Try This:

Sub Macro1()

'

' Macro1 Macro

' Store Data

'

'

Rows("5000:5000").Select

Selection.Copy

Rows("4999:4999").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ScrollRow = 4

'[IMG alt="1589241505112.png"]https://www.mrexcel.com/board/attachments/1589241505112-png.13621/[/IMG]
[U]'Add the if condition[/U]

If Range("B4").Value <> Range("B5000").Value Then

     Rows("4:4").Select

     Selection.Insert Shift:=xlDown

     Rows("6:6").Select

     Application.CutCopyMode = False
End If

If Range("B4").Value = Range("B5000").Value Then
     Selection.Copy

     Rows("4:4").Select

     Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

     SkipBlanks:=False, Transpose:=False

     Application.CutCopyMode = False

     ActiveWindow.ScrollRow = 4999

     Rows("5000:5000").Select

     Selection.Delete Shift:=xlUp

     Sheets("Manpower").Select

     Range("A10").Activate
End If

End Sub

 

[svenkat]

Mr.rhratterman15

Still I am struggling to fix the problem,

My request is in the "data" sheet I want to copy row 5000 and insert, paste values in row 4 if the date is different. If the date is same paste row 5000 on top of row 4. Please find the attached.

It inserts but blank cell. even for both condition it inserts but blank cells. Formatting is correct. I used your suggestion for if condition.

Sub SaveData()
'
' SaveData Macro
'

'
Sheets("Data").Select
If Range("B4").Value <> Range("B5000").Value Then
Rows(4).Insert Shift:=xlDown
Range("5000:5000").Copy
Range("4:4").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Rows(4999).EntireRow.Delete
End If
If Range("B4").Value = Range("B5000").Value Then
Range("5000:5000").Copy
Range("4:4").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
Range("6:6").Copy
Range("4:4").PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Sheets("Manpower").Select
Range("M25").Select
End Sub