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.

Perform a True or False test in the List F1:F9999.
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.
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
The TRUE or FALSE test will run until the end of the list.
The TRUE or FALSE test will stop running if it reached the bottom of the list.
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

enter image description here

Appreaciate if you could help me on this.

Instead of using `.Select`, use a reverse loop. i.e use a for loop and move from down to up (9999 to 1) — Siddharth Rout, Sep 16 '13 at 05:36
It would be nice if you could code it @SiddharthRout so that Kareen will be able to test it. I think she lacks of knowledge. :) just saying.. — Ben Daggers, Sep 16 '13 at 05:41
@BenMichaelOracion: Yes, I can code it (in fact the code is ready) but I would like Kareen to give it a try first :) — Siddharth Rout, Sep 16 '13 at 05:42
To be honest, I really have no Idea how to do it @SiddharthRout. All i can do is the IF and Else statement. been stuck here for 3 hrs. but to repeat it until the IF and else until the last item of the list is what i dont know. by the way, the number of items in the list is not consistent. I just put there E1:E9999 for example purposes. — Kareen Lagasca, Sep 16 '13 at 06:01

score 4 · Accepted Answer · edited May 23 '17 at 10:30

Give this a try.

Explanation:

You should avoid using .Select/ActiveCell etc. You might want to see this LINK
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
Work with Objects, what if the current sheet is not the sheet with which you want to work with?
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:

enter image description here

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.

enter image description here

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]

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. — Kareen Lagasca, Sep 16 '13 at 06:59
no need. found the answer! I changed it to Set ws = ActiveSheet. Thank you very much. You're very helpful. — Kareen Lagasca, Sep 16 '13 at 07:02
Use CodeName of the sheet then.... Again my advice, Please do not use `Activesheet`. — Siddharth Rout, Sep 16 '13 at 07:05
I know. but i think in my case it's appropriate to use the activesheet. and also, it is the easiest way out. :) thank you! — Kareen Lagasca, Sep 16 '13 at 07:11
hmmmm... you have a point! I totally agree with you. Unfortunately, my excel macro project includes adding new sheet up to Sheet99. And the codes you have written will run inside the new created sheets. If I set the ws to Sheet1, it will run coz the sheet has a name of Sheet46 (example). I hope you understand but you have a good point there! — Kareen Lagasca, Sep 16 '13 at 07:19

Carsten Massmann · Answer 2 · 2013-09-16T06:36:16.463

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 ...

Excel Macro Repetitive IF and Else

2 Answers2

Linked