Can Excel Do This For Me????

[Sean]

I have a daily spreadsheet that I drop data into and then go through and sort
through it like so. Please see examples:

RAW DATA BEFORE I DO WHAT I DO TO IT. OR HOPEFULLY EXCEL CAN

Column A Column B
514-212 514-212
514-222 82Q-1A
600QR-NC-D CC4545
6905-213 FB2130-O
6905-223 FB2741-O
82Q-1A FB3648-O
B0081CK-1 FB4430-O
FB2130-O FB4860-O
FB2272-O GFD9400S-B
FB2725-O GS9013-M

THIS IS WHAT THE FINISHED EFFECT LOOKS LIKE AFTER I FINISH!!!

514-212 514-212
514-222
600QR-NC-D
6905-213
6905-223
82Q-1A 82Q-1A
B0081CK-1
CC4545
FB2130-O FB2130-O
FB2272-O
FB2741-O
FB2725-O
FB3648-O
FB4430-O
FB4860-O
GFD9400S-B
GS9013-M

As you can see I go through and move the cells down to match up like items
and leave unlike items by themselves in an numeric to alphabetic order. My
question is Can I write a macro or a formula that does this for me????

Thanks in advance...

 

[bj]

if the data is alread sorted like your sample
a brute force method would be something like

sub srt()
r = 1
10 if cells(r,1 = "" and cells(r,2) = "" then 99
if cells(r,1)=cells(r,2) then r=r+1: goto 10
if cells(r,1)<cells(r,2) then
cells(r,2).select
Selection.Insert Shift:=xlDown
else
cells(r,1).select
Selection.Insert Shift:=xlDown
end if
r=r+1: goto 10
99
end sub


If you will be doing this a bunch it is worthwhile to use the option
explicit and dimension all of the variables
If you need to sort the data that could be added.

 

[Sean]

I enter the the line code as you wrote it however I keep getting an COMPILE
ERROR when I enter it in. on 10 if cells(r,1 = "" and cells(r,2) = "" then
99 any ideas...???

 

[Glenn Ray]

Here's another way to do it, including a sorting function to preface. It
doesn't use Goto's, but rather a Do...Loop.

Option Explicit
Dim r As Integer
Sub Redistribute_Data()
'Find last active cell of range in Cols A&B (may be an easier way, but
this works)
r = Range("A65536").End(xlUp).Row
If Range("B65536").End(xlUp).Row > r Then
r = Range("B65536").End(xlUp).Row
End If

'Sort by Col A & B (assumes a header row on row 1)
Range("A2:B" & r).Sort Key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("B2"), Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
Range("A2").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value < ActiveCell.Offset(0, 1) Then
ActiveCell.Offset(0, 1).Insert shift:=xlDown
ElseIf ActiveCell.Value > ActiveCell.Offset(0, 1).Value Then
ActiveCell.Insert shift:=xlDown
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub


-Glenn Ray
========================

 

[paul.robinson]

Hi
This code will split your columns into pairs, but not sort the list. It
is assumed that your columns start at A1, B1 and that the first row is
headings. Data is output to the columns starting D1, E1

Sub Parse_the_Codes()
Dim CodeRange As Range, CodeRangeValues As Variant
Dim CodePairs As New Collection
Dim i As Long, j As Long, CodePairsCount As Long

Application.ScreenUpdating = False
'Set CodeRange = ActiveSheet.Cells(1, 1).CurrentRegion
CodeRangeValues = ActiveSheet.Cells(1, 1).CurrentRegion.Value
CodeRangeRows = UBound(CodeRangeValues, 1)
On Error Resume Next
For i = 2 To CodeRangeRows
CodePairs.Add VBA.Array(CodeRangeValues(i, 1), ""),
CStr(Trim(CodeRangeValues(i, 1)))
Next i
For i = 2 To CodeRangeRows
CodePairs.Add VBA.Array("", CodeRangeValues(i, 2)),
CStr(Trim(CodeRangeValues(i, 2)))
If Err.Number <> 0 Then
CodePairs.Remove CStr(CodeRangeValues(i, 2))
CodePairs.Add VBA.Array(CodeRangeValues(i, 2),
CodeRangeValues(i, 2)), CStr(Trim(CodeRangeValues(i, 2)))
Err.Clear
End If
Next i
On Error GoTo 0
'output to sheet
With ActiveSheet
.Cells(1, 4).Value = .Cells(1, 1).Value
.Cells(1, 5).Value = .Cells(1, 2).Value
For i = 1 To CodePairsCount
.Cells(1, 4).Offset(i, 0).Resize(1, 2).Value = CodePairs(i)
Next i
End With

Set CodePairs = Nothing
End Sub

regards
Paul

 

[bj]

Mea culpa
it should have been
10 if cells(r,1) = "" and cells(r,2) = "" then 99

 

[paul.robinson]

Hi
Just a short PS:
1. In the code, be careful with line breaks 0 you need to put "space
underscore" at the end of a broken line
2. On sorting. After running the code, copy entries with a blank next
to them onto the blank, and colour the copy red. You now have 2 columns
the same with some red text. Now sort these columns in the normal way
and finish by deleting the red text.

regards
Paul