Question

mikesal57

Board Regular
Joined
Jul 6, 2011
Messages
193
Office Version
  1. 2016
Platform
  1. Windows
Hi All

i have a macro to sort and list data by rows
Can I seperate , with lines or spaces , different groups of names instead of it all together?

ex:

mra.XXXXXXX
-------------
mrb.xxxxxxxxx
mrbxxxxxxxxxx
mrb.xxxxxxxxx
-------------
mrc.xxxxxxxxx
mrc.xxxxxxxxx
-------------
mrd.xxxxxxxxx
-------------

etc

thxs mike
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Try like this

Code:
Sub InsRow()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Range("A" & i).Value <> Range("A" & i - 1).Value Then Rows(i).Insert
Next i
End Sub
 
Upvote 0
Untested:
Code:
Public Sub InsertRow()
Dim lLastRow As Long
lLastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = lLastRow To 2 Step -1
    If Range("A" & i).Value2 <> Range("A" & i - 1).Value2 Then
    Rows(i).Insert Shift:=xlShiftDown
    Range("A" & i).Formula = "=REPT(" & Chr(34) & "-" & Chr(34) & ",150)"
    End If
Next i
End Sub
 
Upvote 0
Please post the MAcro you are using

here ya go..

Sub sortpp()
'
' sortpp Macro
'
'
ActiveWindow.SmallScroll Down:=9
Range("A18:R11969").Select
ActiveWindow.ScrollRow = 11905
ActiveWindow.ScrollRow = 11890
ActiveWindow.ScrollRow = 11876
ActiveWindow.ScrollRow = 11861
ActiveWindow.ScrollRow = 11832
ActiveWindow.ScrollRow = 11818
ActiveWindow.ScrollRow = 11803
ActiveWindow.ScrollRow = 11789
ActiveWindow.ScrollRow = 11774
ActiveWindow.ScrollRow = 11760
ActiveWindow.ScrollRow = 11731
ActiveWindow.ScrollRow = 11716
ActiveWindow.ScrollRow = 11702
ActiveWindow.ScrollRow = 11673
ActiveWindow.ScrollRow = 11658
ActiveWindow.ScrollRow = 11644
ActiveWindow.ScrollRow = 11615
ActiveWindow.ScrollRow = 11600
ActiveWindow.ScrollRow = 11571
ActiveWindow.ScrollRow = 11528
ActiveWindow.ScrollRow = 11470
ActiveWindow.ScrollRow = 11427
ActiveWindow.ScrollRow = 11354
ActiveWindow.ScrollRow = 11253
ActiveWindow.ScrollRow = 11137
ActiveWindow.ScrollRow = 11007
ActiveWindow.ScrollRow = 10847
ActiveWindow.ScrollRow = 10688
ActiveWindow.ScrollRow = 10529
ActiveWindow.ScrollRow = 10370
ActiveWindow.ScrollRow = 10210
ActiveWindow.ScrollRow = 10123
ActiveWindow.ScrollRow = 10007
ActiveWindow.ScrollRow = 9732
ActiveWindow.ScrollRow = 9457
ActiveWindow.ScrollRow = 9211
ActiveWindow.ScrollRow = 8994
ActiveWindow.ScrollRow = 8791
ActiveWindow.ScrollRow = 8574
ActiveWindow.ScrollRow = 8371
ActiveWindow.ScrollRow = 8168
ActiveWindow.ScrollRow = 8009
ActiveWindow.ScrollRow = 7850
ActiveWindow.ScrollRow = 7690
ActiveWindow.ScrollRow = 7531
ActiveWindow.ScrollRow = 7372
ActiveWindow.ScrollRow = 7213
ActiveWindow.ScrollRow = 7053
ActiveWindow.ScrollRow = 6894
ActiveWindow.ScrollRow = 6764
ActiveWindow.ScrollRow = 6619
ActiveWindow.ScrollRow = 6489
ActiveWindow.ScrollRow = 6315
ActiveWindow.ScrollRow = 6155
ActiveWindow.ScrollRow = 5982
ActiveWindow.ScrollRow = 5793
ActiveWindow.ScrollRow = 5620
ActiveWindow.ScrollRow = 5431
ActiveWindow.ScrollRow = 5287
ActiveWindow.ScrollRow = 5127
ActiveWindow.ScrollRow = 4968
ActiveWindow.ScrollRow = 4809
ActiveWindow.ScrollRow = 4635
ActiveWindow.ScrollRow = 4476
ActiveWindow.ScrollRow = 4316
ActiveWindow.ScrollRow = 4157
ActiveWindow.ScrollRow = 4012
ActiveWindow.ScrollRow = 3882
ActiveWindow.ScrollRow = 3766
ActiveWindow.ScrollRow = 3621
ActiveWindow.ScrollRow = 3505
ActiveWindow.ScrollRow = 3404
ActiveWindow.ScrollRow = 3303
ActiveWindow.ScrollRow = 3187
ActiveWindow.ScrollRow = 3085
ActiveWindow.ScrollRow = 2984
ActiveWindow.ScrollRow = 2912
ActiveWindow.ScrollRow = 2825
ActiveWindow.ScrollRow = 2752
ActiveWindow.ScrollRow = 2694
ActiveWindow.ScrollRow = 2651
ActiveWindow.ScrollRow = 2608
ActiveWindow.ScrollRow = 2564
ActiveWindow.ScrollRow = 2506
ActiveWindow.ScrollRow = 2448
ActiveWindow.ScrollRow = 2361
ActiveWindow.ScrollRow = 2289
ActiveWindow.ScrollRow = 2202
ActiveWindow.ScrollRow = 2130
ActiveWindow.ScrollRow = 2043
ActiveWindow.ScrollRow = 1970
ActiveWindow.ScrollRow = 1884
ActiveWindow.ScrollRow = 1811
ActiveWindow.ScrollRow = 1739
ActiveWindow.ScrollRow = 1666
ActiveWindow.ScrollRow = 1579
ActiveWindow.ScrollRow = 1522
ActiveWindow.ScrollRow = 1435
ActiveWindow.ScrollRow = 1377
ActiveWindow.ScrollRow = 1290
ActiveWindow.ScrollRow = 1217
ActiveWindow.ScrollRow = 1073
ActiveWindow.ScrollRow = 957
ActiveWindow.ScrollRow = 826
ActiveWindow.ScrollRow = 653
ActiveWindow.ScrollRow = 595
ActiveWindow.ScrollRow = 493
ActiveWindow.ScrollRow = 392
ActiveWindow.ScrollRow = 334
ActiveWindow.ScrollRow = 233
ActiveWindow.ScrollRow = 146
ActiveWindow.ScrollRow = 88
ActiveWindow.ScrollRow = 44
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 1
Range("A18:R14712").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("A1:R16"), CopyToRange:=Range("U8:AL68"), Unique:=False
Range("U8:AL68").Select
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 1
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("V9:V68") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("U9:U68") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("U8:AL68")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
 
Upvote 0
Maybe

Code:
Sub sortpp()
'
' sortpp Macro
'
'
Dim LR As Long, i As Long

Range("A18:R11969").Select
Range("A18:R14712").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("A1:R16"), CopyToRange:=Range("U8:AL68"), Unique:=False
Range("U8:AL68").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("V9:V68") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("U9:U68") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
    .SetRange Range("U8:AL68")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
With Sheets("Sheet3")
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = LR To 2 Step -1
        If .Range("A" & i).Value <> .Range("A" & i - 1).Value Then .Rows(i).Insert
    Next i
End With
End Sub
 
Upvote 0
VoG...

we are almost there....

My results were copied to u:8 to al68

So after I changed your "A" to "U" I got it working...except

it looks like the blank rows were seperating the same group of names instead of a blank row between different names

also instead of using the whole "U" column, can you make it within my u8 to al68

thxs

mike
 
Upvote 0
Can anyone fix my macro where its inserting the blank row?

I'm getting the reverse effect of what i need..

mra.xxxxxx
mrb.xxxxxx

mrb.xxxxxx

mrb.xxxxxx

mrb.xxxxxx
mrc.xxxxxx

mrc.xxxxxx
mrd.xxxxxx

etc

thxs
mike
 
Upvote 0
Try

Code:
Sub sortpp()
'
' sortpp Macro
'
'
Dim LR As Long, i As Long

Range("A18:R11969").Select
Range("A18:R14712").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("A1:R16"), CopyToRange:=Range("U8:AL68"), Unique:=False
Range("U8:AL68").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("V9:V68") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("U9:U68") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
    .SetRange Range("U8:AL68")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
With Sheets("Sheet3")
    LR = 68
    For i = LR To 9 Step -1
        If .Range("U" & i).Value <> .Range("U" & i - 1).Value Then .Rows(i).Insert
    Next i
End With
End Sub

]/code]
 
Upvote 0

Forum statistics

Threads
1,224,550
Messages
6,179,463
Members
452,915
Latest member
hannnahheileen

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