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.
[1017 byte] By [
neRok] at [2007-12-23]
Per one of our support engineers:
Our buddy wants a specific sorting method in his Excel Workbook. Here’s my update.
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 budsup@microsoft.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.
