Excel Macro Repetitive IF and Else

Question

I am currently working on an Excel VBA Macro script where in it will do a simple TRUE or False test to the active cell. My problem is, i cannot make this working until the end of the list. It only run once and ends the program. I need this VB script to perform the IF & ELSE test up to the bottom of the list.

Description of the problem:

Let's say i have a list of dates in A1 to A9999 and beside it (F1:F9999) there's also a list that has a text on it. the F1:F9999 list contains two values only. (a)SAME DATE and (b) NOT THE SAME.

1. Perform a True or False test in the List F1:F9999.

2. If the active cell value is equal to the text "SAME DATE" (TRUE), it will ignore and move to the next item in the list then perform again number 1.

3. If the active cell value is equal to the text "SAME DATE" (FALSE), it will insert a row above it and then move to the next item in the list then perform again number 1
4. The TRUE or FALSE test will run until the end of the list.
5. The TRUE or FALSE test will stop running if it reached the bottom of the list.
6. by the way, the number of items in the list is not consistent. I just put there F1:F9999 for example purposes.

here's my code!

Sub IFandElseTest()
If ActiveCell.Value = "Same Date" Then
Range(Selection, Cells(ActiveCell.Row, 1)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(1, 0).Select
Else:
ActiveCell.Offset(1, 0).Select
Range(Selection, Cells(ActiveCell.Row, 1)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If


End Sub

Appreaciate if you could help me on this.

Answer 1

Give this a try.

Explanation:

1. You should avoid using .Select/ActiveCell etc. You might want to see this LINK
2. When working with the last row, it's better not to hard code values but dynamically find the last row. You might want to see this LINK
3. Work with Objects, what if the current sheet is not the sheet with which you want to work with?
4. The below FOR loop will traverse the row from below and move up.

Code:

Sub Sample()
    Dim ws As Worksheet
    Dim LRow As Long, i As Long
    Dim insertRange As Range

    '~~> Chnage this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    '~~> Work with the relevant sheet
    With ws
        '~~> Get the last row of the desired column
        LRow = .Range("E" & .Rows.Count).End(xlUp).Row

        '~~> Loop from last row up
        For i = LRow To 1 Step -1
            '~~> Check for the condition
            '~~> UCASE changes to Upper case
            '~~> TRIM removes unwanted space from before and after
            If UCase(Trim(.Range("E" & i).Value)) = "SAME DATE" Then
                '~~> Insert the rows
                .Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        Next i
    End With
End Sub

Screenshot:

Followup From Comments

It really worked! BUT, one final modification. in your code: Set ws = ThisWorkbook.Sheets("Sheet1") Is it possible is you can set the WS as the Active worksheet. The reason of this is because the name of the worksheet unique and not consistent also.

Like I mentioned, in the first link above as well in the comment, do not use Activesheet. Use CodeNames of the sheet which do not change. See the screenshot below.

Blah Blah is the name of the sheet which you see in the worksheet tab but Sheet1 is the CodeName which will not change. i.e. you can change the name of the sheet from Blah Blah to say Kareen but in the VBA editor, you will notice that the Codename doesn't change :)

Change the code

Set ws = ThisWorkbook.Sheets("Sheet1")

to

'~~> Replace Sheet1 with the relevant Code Name
Set ws = [Sheet1]

Answer 2

Edit:

If you leave out the r.copy line it does more or less exactly what Siddharth Rout's solution does

Sub insrow()
  Dim v, r As Range
  Set r = [d1:e1]
  v = r.Columns(1).Value
  Do
   ' r.copy
   If v = "Same Date" Then r.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   Set r = r.Offset(1)
   v = r.Columns(1).Value
  Loop Until v = ""
End Sub

This does not yet include the end condition if row exceeds line 9999 but that should be easy to add ...