Require Basic Excel Sorting Macro To Be Made For Me!!! (Pretty Basic, But I Have NFI!)

I was wondering if someone could make me some code for Excel 2000. I want it to start at C1, check if C2 is the same as it, and if not insert a row between. Then check if C3 is the same as C4 and if not insert another row. So if my data looked like the left list it would turn out like the right list.

Apple                                                 Apple
Apple                                                 Apple
Banana
Banana                                               Banana
Banana                                              Banana
Grape                                                 Banana
Orange
Orange                                               Grape
Orange
                                                        Orange
                                                        Orange
                                                        Orange

I dont know how to code this but in semi-lamens terms it would be something like

ROW=0
ROWE=1

:START

   If ROW = 10000
      Then Goto BOTTOM
   End If

   ROW=ROW+1
   ROWE=ROWE+1

   Range.("C"+ROWE).Select

   If Cell("C",ROW) = Cell("C",ROWE)
      Then Goto START
      Else Insert Row
   End If

Goto Start

:BOTTOM

Obviously some of this code could be replaced to be made better with something like a Do statement. I just cant work out how to do this.

Microsoft ISV Community Center Forums2

Per one of our support engineers:

Our buddy wants a specific sorting method in his Excel Workbook. Here’s my update.< xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />

Public Sub ProcessData()

Const ColIdx = 3 'index of C Column

Dim oSheet As Worksheet

Set oSheet = ActiveWorkbook.ActiveSheet ‘Get the active sheet

Dim MaxRow As Integer

Dim SourceRowIdx As Integer

Dim TargetRowIdx As Integer

MaxRow = oSheet.UsedRange.Rows.Count ‘Max row index of used area on worksheet

SourceRowIdx = 1 ‘Source column

TargetRowIdx = 1

While SourceRowIdx < MaxRow

If oSheet.Cells(SourceRowIdx, ColIdx).Value = oSheet.Cells(SourceRowIdx + 1, ColIdx).Value Then

oSheet.Cells(TargetRowIdx, ColIdx + 1).Value = oSheet.Cells(SourceRowIdx, ColIdx).Value

TargetRowIdx = TargetRowIdx + 1

Else

oSheet.Cells(TargetRowIdx, ColIdx + 1).Value = oSheet.Cells(SourceRowIdx, ColIdx).Value

oSheet.Cells(TargetRowIdx + 1, ColIdx + 1).Value = ""

TargetRowIdx = TargetRowIdx + 2

End If

SourceRowIdx = SourceRowIdx + 1

Wend

End Sub

The engineer also attach a sample Excel file in his email. If you'd like to get that file, since I can't attach it here, please email me at EMail@HideDomain.com.

thanks,
-brenda (ISV Buddy Team)

neRoc

Below probably another solution

Public Sub InsertBlancRows()

Application.ScreenUpdating = False 'Speeds up
Application.Calculation = xlCalculationManual 'Speeds up: if there are many formulas

'Declaring Variables
Dim Idx As Long 'row counter in selection
Dim cIdx As Long 'Col.nr in selection
Dim Max As Long '
Dim ShMax As Long
ShMax = ActiveCell.SpecialCells(xlLastCell).Row

With Selection
Max = .Rows.Count
For Idx = 2 To Max
If .Cells(Idx, cIdx) <> "" Then 'Only non-blanc cells in the first column
If ShMax > .Cells(Idx, cIdx).Row + Max - Idx Then 'Controling max sheet size
If .Cells(Idx - 1, cIdx) <> "" And .Cells(Idx, cIdx) <> .Cells(-1 + Idx, cIdx) Then
.Cells(Idx, cIdx).EntireRow.Insert
'Extra Upgrading the counter and limit
Max = Max + 1
Idx = Idx + 1
End If
Else
MsgBox "Function aborted:" & Chr(10) & "Maximum rows exceeded"
Idx = Max 'Next loop will not be executed
End If
End If
Next
End With
Application.Calculation = xlCalculationAutomatic
Selection.Cells(1, cIdx).Resize(Max, Selection.Columns.Count).Select 'New selection
End Sub

Kind regards & Suc6

FiftyFive

Sub InsertRow()
'
' Macro Created
' 31/08/2006 by
' Jerzy Ciechanowski
'
Range("C2").Select
While ActiveCell.Value <> ""
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
ActiveCell.Offset(1, 0).Select
Else
Selection.EntireRow.Insert
ActiveCell.Offset(2, 0).Select
End If
Wend
End Sub

kangur wrote:
Sub InsertRow()
'
' Macro Created
' 31/08/2006 by
' Jerzy Ciechanowski
'
Range("C2").Select
While ActiveCell.Value <> ""
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
ActiveCell.Offset(1, 0).Select
Else
Selection.EntireRow.Insert
ActiveCell.Offset(2, 0).Select
End If
Wend
End Sub

Well, -2 points for using the macro recorder, but +4 for compactness! (Gee, does the macro recorder still use While/Wend ) I don't like using .Offset personally, but it seems like the neatest way to get the job done here.

Hi duck thing,

I didn't know the Macro Recorder uses decision structures.