VBA: Move Some Rows

[Rixn]

I need help in moving some rows.

I've got this in sheet "Import":

Excel Workbook
	D	E	F
10	Alpha	1	Orange
11	Alpha	2	Light Green
12	Alpha	3	Red
13	Alpha	4	Dark Blue
14	Charlie	1	Blue
15	Charlie	2	Dark Brown
16	Zulu	1	Purple
17	Zulu	2	Black
18	Zulu	3	Gray
19	Delta	1	Dark Purple
20	Delta	2	Green
21	Delta	3	Light Blue
22	Zulu	1	Brown
23	Zulu	2	Yellow
24	Zulu	3	Dark Red
25	Beta	1	Pink
26	Beta	2	White
27	Beta	3	Dark Green
28	Beta	4	Beige
Sheet

..and I've extracted the information of which rows it is where every new unique entry occurs (I keep it in sheet "SE"):

Excel Workbook
	A	B
1	Alpha	10
2	Charlie	14
3	Zulu	16
4	Delta	19
5	Zulu	22
6	Beta	25
7	*	29
Sheet

My objective is to rearrange the rows of the initial table so the "Zulu" rows ends up last, like this:

Excel Workbook
	D	E	F
10	Alpha	1	Orange
11	Alpha	2	Lighr Green
12	Alpha	3	Red
13	Alpha	4	Dark Blue
14	Charlie	1	Blue
15	Charlie	2	Dark Brown
16	Delta	1	Dark Purple
17	Delta	2	Green
18	Delta	3	Light Blue
19	Beta	1	Pink
20	Beta	2	White
21	Beta	3	Dark Green
22	Beta	4	Beige
23	Zulu	1	Purple
24	Zulu	2	Black
25	Zulu	3	Gray
26	Zulu	1	Brown
27	Zulu	2	Yellow
28	Zulu	3	Dark Red
Sheet

 

[patel45]

do you want make a sorting ?

 

[Rixn]

No, I want to move the Zulu rows to the end of the list.

 

[Marcelo Branco]

Maybe this...

Puts the arranged data on a new sheet (named New)

Sub arrData()
    Dim arrOthers() As Variant, arrZulu() As Variant, numRows As Long
    Dim lastRow As Long, rngData As Variant, countZulu As Long, i As Long, j As Long, lin As Long
    
    With Sheets("Import")
        lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
        numRows = .Range("D10:F" & lastRow).Rows.Count
        countZulu = Application.CountIf(.Range("D10:D" & lastRow), "Zulu")
                
        rngData = .Range("D10:F" & lastRow).Value
                
        ReDim arrOthers(1 To numRows - countZulu, 1 To 3)
        ReDim arrZulu(1 To countZulu, 1 To 3)
        
        For lin = 1 To numRows
            If rngData(lin, 1) = "Zulu" Then
                i = i + 1
                arrZulu(i, 1) = rngData(lin, 1)
                arrZulu(i, 2) = rngData(lin, 2)
                arrZulu(i, 3) = rngData(lin, 3)
            Else
                j = j + 1
                arrOthers(j, 1) = rngData(lin, 1)
                arrOthers(j, 2) = rngData(lin, 2)
                arrOthers(j, 3) = rngData(lin, 3)
            End If
        Next lin
    End With
    
    Sheets.Add
    ActiveSheet.Name = "New"
    
    With Sheets("New")
       .Range("D10").Resize(numRows - countZulu, 3) = arrOthers
       .Range("D10").Offset(numRows - countZulu).Resize(countZulu, 3) = arrZulu
    End With
        
End Sub

M.

 

[patel45]

Sub a()
ThisWorkbook.Sheets.Add.Name = "Service"
Application.DisplayAlerts = False
With Sheets("Import")
  LR = .Cells(.Rows.Count, "D").End(xlUp).Row
  drow = 1
  For j = 10 To LR
    If .Range("D" & j) = "Zulu" Then
      .Range("D" & j & ":F" & j).Copy Sheets("Service").Cells(drow, 1)
      drow = drow + 1
      .Rows(j).Delete
      j = j - 1
    End If
  Next
  LR = .Cells(.Rows.Count, "D").End(xlUp).Row
  Sheets("Service").Range("A1:C" & drow).Copy .Range("D" & LR + 1)
  Sheets("Service").Delete
End With
End Sub

 

[Rixn]

@Marcelo Branco
Thanx for your suggestion.
I looked into it, but I'm looking for a solution that just re-arrange the existing list in D10:F28 in sheet "Import". I lack knowledge to adjust your suggestion into what I want.

 

[Rixn]

@patel45
Thanx for your suggestion too!
I think I get how it works, but I'm not sure about the "Service" part - can you please explain it a bit more, maybe comment the rows of importance so I know what's happening?

 

[Marcelo Branco]

@Marcelo Branco
Thanx for your suggestion.
I looked into it, but I'm looking for a solution that just re-arrange the existing list in D10:F28 in sheet "Import". I lack knowledge to adjust your suggestion into what I want.

Maybe...

Try it in a copy of your workbook

Sub arrTest()
    Dim arrOthers() As Variant, arrZulu() As Variant, rcell As Range
    Dim lastRow As Long, rngData As Range, countZulu As Long, i As Long, j As Long
    
    With Sheets("Import")
        lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
        Set rngData = .Range("D10:F" & lastRow)
        countZulu = Application.CountIf(rngData.Columns(1), "Zulu")
        
        ReDim arrOthers(1 To rngData.Rows.Count - countZulu, 1 To 3)
        ReDim arrZulu(1 To countZulu, 1 To 3)
        
        For Each rcell In rngData.Columns(1).Cells
            If rcell = "Zulu" Then
                i = i + 1
                arrZulu(i, 1) = rcell.Value
                arrZulu(i, 2) = rcell.Offset(, 1).Value
                arrZulu(i, 3) = rcell.Offset(, 2).Value
            Else
                j = j + 1
                arrOthers(j, 1) = rcell.Value
                arrOthers(j, 2) = rcell.Offset(, 1).Value
                arrOthers(j, 3) = rcell.Offset(, 2).Value
            End If
        Next rcell
        
        .Range("D10").Resize(rngData.Rows.Count - countZulu, 3) = arrOthers
        .Range("D10").Offset(rngData.Rows.Count - countZulu).Resize(countZulu, 3) = arrZulu
    End With
        
End Sub

M.

 

[patel45]

@patel45
Thanx for your suggestion too!
I think I get how it works, but I'm not sure about the "Service" part - can you please explain it a bit more, maybe comment the rows of importance so I know what's happening?

1) create service sheet
2) copy ranges with zulu to service sheet
3) delete rows with zulu on sheet Import
4) copy ranges with zulu to import sheet
5) delete service sheet

 

[Rixn]

@Marcelo Branco
Thanx again!
As you can see @patel45 also submitted a solution. May I ask what is better with your solution?
(and if you have time, can you please comment the important rows so I can learn better what your code do?)