INSERT ROW WITH SPECIFIS TEXT IN A COLUMN

xenios

Board Regular
Joined
Sep 4, 2020
Messages
88
Office Version
  1. 2016
Platform
  1. Windows
Hi All!

How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F.

If I record the macro it gives me the following result.
VBA Code:
Sub INSERT()
'
' INSERT Macro
'

'
    Rows("2:2").Select
    Selection.INSERT Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "JUICE"
    Range("A2:G2").Select
    Range("G2").Activate
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlLTR
        .MergeCells = False
    End With
    Selection.Copy
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 22
    ActiveWindow.ScrollRow = 23
    ActiveWindow.ScrollRow = 24
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 26
    ActiveWindow.ScrollRow = 27
    ActiveWindow.ScrollRow = 28
    ActiveWindow.ScrollRow = 29
    ActiveWindow.ScrollRow = 30
    ActiveWindow.ScrollRow = 31
    ActiveWindow.ScrollRow = 32
    ActiveWindow.ScrollRow = 33
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 35
    ActiveWindow.ScrollRow = 36
    ActiveWindow.ScrollRow = 37
    ActiveWindow.ScrollRow = 38
    ActiveWindow.ScrollRow = 39
    ActiveWindow.ScrollRow = 40
    ActiveWindow.ScrollRow = 41
    ActiveWindow.ScrollRow = 42
    ActiveWindow.ScrollRow = 43
    ActiveWindow.ScrollRow = 44
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 46
    ActiveWindow.ScrollRow = 47
    ActiveWindow.ScrollRow = 48
    ActiveWindow.ScrollRow = 49
    ActiveWindow.ScrollRow = 50
    ActiveWindow.ScrollRow = 51
    ActiveWindow.ScrollRow = 52
    ActiveWindow.ScrollRow = 53
    ActiveWindow.ScrollRow = 54
    ActiveWindow.ScrollRow = 55
    ActiveWindow.ScrollRow = 56
    ActiveWindow.ScrollRow = 57
    ActiveWindow.ScrollRow = 58
    ActiveWindow.ScrollRow = 62
    ActiveWindow.ScrollRow = 66
    ActiveWindow.ScrollRow = 68
    ActiveWindow.ScrollRow = 69
    ActiveWindow.ScrollRow = 70
    ActiveWindow.ScrollRow = 71
    ActiveWindow.ScrollRow = 72
    Rows("82:82").Select
    Selection.INSERT Shift:=xlDown
    Range("A82").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "MELON"
    Range("A82:G82").Select
    Range("G82").Activate
    Selection.Copy
    ActiveWindow.ScrollRow = 73
    ActiveWindow.ScrollRow = 74
    ActiveWindow.ScrollRow = 77
    ActiveWindow.ScrollRow = 79
    ActiveWindow.ScrollRow = 80
    ActiveWindow.ScrollRow = 82
    ActiveWindow.ScrollRow = 83
    ActiveWindow.ScrollRow = 84
    ActiveWindow.ScrollRow = 85
    ActiveWindow.ScrollRow = 87
    ActiveWindow.ScrollRow = 88
    ActiveWindow.ScrollRow = 89
    ActiveWindow.ScrollRow = 90
    ActiveWindow.ScrollRow = 91
    ActiveWindow.ScrollRow = 92
    ActiveWindow.ScrollRow = 93
    ActiveWindow.ScrollRow = 94
    ActiveWindow.ScrollRow = 95
    ActiveWindow.ScrollRow = 96
    ActiveWindow.ScrollRow = 97
    ActiveWindow.ScrollRow = 99
    ActiveWindow.ScrollRow = 101
    ActiveWindow.ScrollRow = 102
    ActiveWindow.ScrollRow = 103
    ActiveWindow.ScrollRow = 104
    ActiveWindow.ScrollRow = 105
    ActiveWindow.ScrollRow = 106
    ActiveWindow.ScrollRow = 107
    ActiveWindow.ScrollRow = 108
    ActiveWindow.ScrollRow = 109
    ActiveWindow.ScrollRow = 110
    ActiveWindow.ScrollRow = 112
    ActiveWindow.ScrollRow = 114
    ActiveWindow.ScrollRow = 117
    ActiveWindow.ScrollRow = 118
    ActiveWindow.ScrollRow = 119
    ActiveWindow.ScrollRow = 120
    ActiveWindow.ScrollRow = 121
    ActiveWindow.ScrollRow = 122
    ActiveWindow.ScrollRow = 123
    ActiveWindow.ScrollRow = 124
    Rows("132:132").Select
    Selection.INSERT Shift:=xlDown
    Range("A132").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "APPLE"
    Range("A132:G132").Select
    Range("G132").Activate
    Selection.Copy
    ActiveWindow.ScrollRow = 125
    ActiveWindow.ScrollRow = 127
    ActiveWindow.ScrollRow = 129
    ActiveWindow.ScrollRow = 132
    ActiveWindow.ScrollRow = 140
    ActiveWindow.ScrollRow = 143
    ActiveWindow.ScrollRow = 145
    ActiveWindow.ScrollRow = 147
    ActiveWindow.ScrollRow = 148
    ActiveWindow.ScrollRow = 149
    ActiveWindow.ScrollRow = 150
    ActiveWindow.ScrollRow = 151
    ActiveWindow.ScrollRow = 152
    ActiveWindow.ScrollRow = 153
    ActiveWindow.ScrollRow = 154
    ActiveWindow.ScrollRow = 157
    ActiveWindow.ScrollRow = 160
    ActiveWindow.ScrollRow = 162
    ActiveWindow.ScrollRow = 163
    ActiveWindow.ScrollRow = 164
    ActiveWindow.ScrollRow = 165
    ActiveWindow.ScrollRow = 166
    ActiveWindow.ScrollRow = 167
    ActiveWindow.ScrollRow = 168
    ActiveWindow.ScrollRow = 169
    ActiveWindow.ScrollRow = 170
    ActiveWindow.ScrollRow = 171
    Rows("183:183").Select
    Selection.INSERT Shift:=xlDown
    Range("A183").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "LIME"
    Range("B184").Select
End Sub
 

Attachments

  • insert.png
    insert.png
    176.5 KB · Views: 13

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,247
Office Version
  1. 2013
Platform
  1. Windows
Still cannot understand what you want. Hoping someone else here will be able to help you
 

Some videos you may like

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

xenios

Board Regular
Joined
Sep 4, 2020
Messages
88
Office Version
  1. 2016
Platform
  1. Windows
Still cannot understand what you want. Hoping someone else here will be able to help you
Thank you for the try.
Here are the last example for understanding, may be will help :)
The initial and the result needed.
 

Attachments

  • INITIAL.png
    INITIAL.png
    170.7 KB · Views: 5
  • RESULT.png
    RESULT.png
    171.6 KB · Views: 5

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,247
Office Version
  1. 2013
Platform
  1. Windows
In your initial image you have Alpha twice.
But in your result page you only showed one row inserted for alpha
Is that a mistake? if not why?
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
781
Office Version
  1. 2013
Platform
  1. Windows
Hi xenios
Would you try this
VBA Code:
Sub test()
    Dim lr, i, l
    Dim x, a, y
    Dim sh
    ReDim a(1 To 100)
    Application.ScreenUpdating = False
    Set sh = ActiveSheet
    lr = sh.Cells(Rows.Count, 6).End(xlUp).Row
    With CreateObject("scripting.dictionary")
        For i = 2 To lr
            If Not .exists(Cells(i, 6).Value) Then
                .Add Cells(i, 6).Value, Cells(i, 6).Address
            End If
        Next
        y = .items
       For i = UBound(y) To 0 Step -1
       Range(y(i)).EntireRow.Insert
        Range(y(i)) = Range(y(i)).Offset(1)
        Range(y(i)).Offset(, -5).Resize(, 7).Merge
        Range(y(i)).HorizontalAlignment = xlCenter
       Next
    End With
    Application.ScreenUpdating = True
End Sub
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
781
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Or Maybe
VBA Code:
Sub test()
    Dim lr, i, l
    Dim x, a, y
    Dim sh
    ReDim a(1 To 100)
    Application.ScreenUpdating = False
    Set sh = ActiveSheet
    lr = sh.Cells(Rows.Count, 6).End(xlUp).Row
    With CreateObject("scripting.dictionary")
        For i = 2 To lr
            If Not .exists(Cells(i, 6).Value) Then
                .Add Cells(i, 6).Value, Cells(i, 6).Address
            End If
        Next
        For i = .Count - 1 To 0 Step -1
            Range(.Items()(i)).EntireRow.Insert
            Range(.Items()(i)) = Range(y(i)).Offset(1)
            Range(.Items()(i)).Offset(, -5).Resize(, 7).Merge
            Range(.Items()(i)).HorizontalAlignment = xlCenter
        Next
    End With
    Application.ScreenUpdating = True
End Sub
 

xenios

Board Regular
Joined
Sep 4, 2020
Messages
88
Office Version
  1. 2016
Platform
  1. Windows
Hi xenios
Would you try this
VBA Code:
Sub test()
    Dim lr, i, l
    Dim x, a, y
    Dim sh
    ReDim a(1 To 100)
    Application.ScreenUpdating = False
    Set sh = ActiveSheet
    lr = sh.Cells(Rows.Count, 6).End(xlUp).Row
    With CreateObject("scripting.dictionary")
        For i = 2 To lr
            If Not .exists(Cells(i, 6).Value) Then
                .Add Cells(i, 6).Value, Cells(i, 6).Address
            End If
        Next
        y = .items
       For i = UBound(y) To 0 Step -1
       Range(y(i)).EntireRow.Insert
        Range(y(i)) = Range(y(i)).Offset(1)
        Range(y(i)).Offset(, -5).Resize(, 7).Merge
        Range(y(i)).HorizontalAlignment = xlCenter
       Next
    End With
    Application.ScreenUpdating = True
End Sub
Thank you. This one works. But makes grey only the 1st new row. If possible for the rest would be great and if text can be transformed to All caps, would be great also.
 

xenios

Board Regular
Joined
Sep 4, 2020
Messages
88
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

In your initial image you have Alpha twice.
But in your result page you only showed one row inserted for alpha
Is that a mistake? if not why?
 

xenios

Board Regular
Joined
Sep 4, 2020
Messages
88
Office Version
  1. 2016
Platform
  1. Windows
In your initial image you have Alpha twice.
But in your result page you only showed one row inserted for alpha
Is that a mistake? if not why?
Alpa, cat, dog, .. can be up to 100 times in column F, and the row up on them is only once.
Can be
Alpha
Alpha
Cat
Cat
Cat
Dog
Dog
 

xenios

Board Regular
Joined
Sep 4, 2020
Messages
88
Office Version
  1. 2016
Platform
  1. Windows
Or Maybe
VBA Code:
Sub test()
    Dim lr, i, l
    Dim x, a, y
    Dim sh
    ReDim a(1 To 100)
    Application.ScreenUpdating = False
    Set sh = ActiveSheet
    lr = sh.Cells(Rows.Count, 6).End(xlUp).Row
    With CreateObject("scripting.dictionary")
        For i = 2 To lr
            If Not .exists(Cells(i, 6).Value) Then
                .Add Cells(i, 6).Value, Cells(i, 6).Address
            End If
        Next
        For i = .Count - 1 To 0 Step -1
            Range(.Items()(i)).EntireRow.Insert
            Range(.Items()(i)) = Range(y(i)).Offset(1)
            Range(.Items()(i)).Offset(, -5).Resize(, 7).Merge
            Range(.Items()(i)).HorizontalAlignment = xlCenter
        Next
    End With
    Application.ScreenUpdating = True
End Sub
Here is error 13, pic attached
 

Attachments

  • Untitled.png
    Untitled.png
    25.5 KB · Views: 3

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
781
Office Version
  1. 2013
Platform
  1. Windows
OOOPs
Sorry
Try
VBA Code:
Sub test()
    Dim lr, i, l
    Dim x, a, y
    Dim sh
    ReDim a(1 To 100)
    Application.ScreenUpdating = False
    Set sh = ActiveSheet
    lr = sh.Cells(Rows.Count, 6).End(xlUp).Row
    With CreateObject("scripting.dictionary")
        For i = 2 To lr
            If Not .exists(Cells(i, 6).Value) Then
                .Add Cells(i, 6).Value, Cells(i, 6).Address
            End If
        Next
        For i = .Count - 1 To 0 Step -1
            Range(.Items()(i)).EntireRow.Insert
            Range(.Items()(i)) = Range(.Items()(i)).Offset(1)
            Range(.Items()(i)).Offset(, -5).Resize(, 7).Merge
            Range(.Items()(i)).HorizontalAlignment = xlCenter
        Next
    End With
    Application.ScreenUpdating = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,118,269
Messages
5,571,227
Members
412,372
Latest member
JON_ROCKS
Top