INSERT ROW WITH SPECIFIS TEXT IN A COLUMN

xenios

xenios

Board Regular
Joined
Sep 4, 2020
Messages
91
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: 23
Sort by date Sort by votes
Still cannot understand what you want. Hoping someone else here will be able to help you
 
Upvote 0

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.
My Aswer Is This said:
Still cannot understand what you want. Hoping someone else here will be able to help you
Click to expand...
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: 9
  • RESULT.png
    RESULT.png
    171.6 KB · Views: 10
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
mohadin said:
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
Click to expand...
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.
 
Upvote 0
My Aswer Is This said:
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?
Click to expand...
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
 
Upvote 0
mohadin said:
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
Click to expand...
Here is error 13, pic attached
 

Attachments

  • Untitled.png
    Untitled.png
    25.5 KB · Views: 9
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
ActiveSheet. Paste error
Replies
1
Views
335
RoryA
RoryA
P
  • Question Question
Help with Vba Code
Replies
3
Views
433
Coyotex3
C
An Quala
  • Question Question
Should I name it Active.Sheet or sheet name?
Replies
8
Views
893
MARK858
MARK858
M
  • Question Question
VBS Crash
Replies
1
Views
747
Alex Blakenburg
A
S
  • Question Question
What could be refreshing my ODBC connections in this code?
Replies
0
Views
655
sspatriots
S

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top