VBA Program error...???

S

Sean

So I got this sort program below

sub srt()
r = 1
10 if cells(r,1) = "" and cells(r,2) = "" then goto 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

It works fine however I need it to assume there is a HEADER ROW and to move
cells 1-4 as a group and 5-8 as a group when cell 1 or 5 match or do not
match as the program runs. Also I need it to stop when it comes to the end.
Right now it continually runs the last item all the way to the bottom of the
sheet cell 64336 or something like that. Please help

Sample of what date looks like before:

HEADER HEADER
6905-323 EE-24 > NIL -1 514-312 NIL > EE-22 1
850CK-3 DD-05 > NIL -1 514-322 NIL > EE-23 1
BB709-D DD-13 > NIL -1 811-01QFB NIL > DD-14 1
CC7033 DD-00 > NIL -1 811-01QHBNIL > DD-14 1
CC7119 DD-00 > NIL -1 850CK-3 NIL > DD-03 1
CMC377 EE-07 > NIL -1 850CK-3 NIL > DD-04 1
CMC377 EE-07 > NIL -1 B0081CK-1 NIL > EE-20 1
CMC377 EE-07 > NIL -1 BB709-D NIL > DD-12 1
CMC377 EE-07 > NIL -1 CC4584 NIL > DD-15 1
CMC377 EE-07 > NIL -1 CC7033 NIL > DD-15 1
CMC377 EE-07 > NIL -1 CC7119 NIL > DD-15 1
FB3648-O EE-00 > NIL -1 CMC394 NIL > EE-07 1
FB3672-O EE-00 > NIL -1 CMC394 NIL > EE-07 1
FB3648-O NIL > EE-19 1
FB3672-O NIL > EE-19 1
FB3672-O NIL > EE-19 1
FB3673-O NIL > EE-19 1

Sample of what I WANT DATA to look like before.

HEADER HEADER
514-312 NIL > EE-22 1
514-322 NIL > EE-23 1
6905-323 EE-24 > NIL -1 811-01QFB NIL > DD-14 1
811-01QHBNIL > DD-14 1
850CK-3 DD-05 > NIL -1 850CK-3 NIL > DD-03 1
850CK-3 NIL > DD-04 1
B0081CK-1 NIL > EE-20 1
BB709-D DD-13 > NIL -1 BB709-D NIL > DD-12 1
CC4584 NIL > DD-15 1
CC7033 DD-00 > NIL -1 CC7033 NIL > DD-15 1
CC7119 DD-00 > NIL -1 CC7119 NIL > DD-15 1
CMC377 EE-07 > NIL -1
CMC377 EE-07 > NIL -1
CMC377 EE-07 > NIL -1
CMC377 EE-07 > NIL -1
CMC377 EE-07 > NIL -1
CMC377 EE-07 > NIL -1
CMC394 NIL > EE-07 1
CMC394 NIL > EE-07 1
FB3648-O EE-00 > NIL -1 FB3648-O NIL > EE-19 1
FB3672-O EE-00 > NIL -1 FB3672-O NIL > EE-19 1
FB3672-O NIL > EE-19 1
FB3673-O NIL > EE-19 1

Already have a process that SORTS it numeric to alphabetic just need to add
or change the current program to do the following. If anyone can help that
would be ideal. I also would like to color the discrepencies (Things that
dont match) in yellow.

Let me know if anyone has any great ideas or possibly a place where I can
learn how to better write these things myself...

Thanks

Sean
 
P

Patrick Molloy

I'm afraid that I don't understand what you're trying to achieve, HOW do you
want to get from the first table to the second. Showing the result simply
gives me no clue as to how you get there. Are there two columns of data?
what conditions appy to copy the first two items of the second column to the
top of the first.
this is really vague.please think about it and ask again. thanks
 
S

Sean

I'm sorry for being vague. The are a total of eight columns of data. I am
importing data from my companies STORIS program over to Excel and reporting
that way. The best way to explain it from scratch would by this.

Cell A1 has APPLE in it and cells B1,C1,D1 all tell you additional
information about A1

Cell E1 has APPLE in it and cells F1,G1,H1 all tell you additional
information about E1

These eight cells should all stay together in a row from left to right as
they are. No problem with that.

Cell A2 has ORANGE in it and cells B2,C2,D2 all tell you additional
information about A2

Cell E2 has BANNANA in it and cells F2,G2,H2 all tell you additional
information about E2

This is wrong so I would like a marcro or program to go through and clean
these discrepancies for me.

A B C D E F
G H
HEADER ROW HEADER ROW
1 apple is a fruit apple is
a fruit
2 orange is a fruit
3 Bannana is
a fruit
4 orange is a fruit orange is
a fruit

This is how it should look. If Cell A1 does not match with cell E1 then
insert a cell, but it needs to insert cells F1,G1,H1 at the same time. It
does not matter if the other ones dont match the only cells that need to be
alike are A1 and E1 other wise it would move things accordingly like in cells
A2:D2 above because it didnt match correctly with E2:H2 and it moved E2:H2
down to E3:E4. This is very hard to expalin this way, but maybe its a little
better this time. I'm still fairly new at the whole vba part of it. I can
send anyone the spreadsheet if they would take a look it may help better
understand if this explanation does not. I can be reached at:
(e-mail address removed)

Again sorry for the poor explanation the first time hope this is better, it
also needs to run in a numeric to alpabetic formula.

Thanks in advance to everyone....

Sean
 
T

Tom Ogilvy

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

The routine should stop when a blank cell is encountered in either column A
or E.
The routine depends on the data being sorted.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top