macro creation to format mulitple rows in a list *difficult*

[Guest]

I have been playing with the macro recorder, and I know understand that the
possibilies are almost endless.. If i can find someone that would not mind
helping me write the macro..

I have 2 columns of names which are in columns from "I2 to I1502" and then
columns "J2 to j1502". The list do not exactly match, as the example down
below shows... I would like the 2 list to come out to be equal... If there is
a name in columnI but not in columnJ, and space would be inserted and left
blank (preferebly colored a color) If there is a name in columnJ but not in
columnI, a space would be inserted in columnI and left blank (or colored a
different color than before..

Before macro runs
Column I Column J
AntiVirus AntiVirus
Anubis Anubis
Apoc Apoc
apocalypso apocalypso
apple Apollyon
aramil apple
Archos aramil
Ares Archos
Argan Ares

After Macro runs
Column I Column J
AntiVirus AntiVirus
Anubis Anubis
Apoc Apoc
apocalypso apocalypso
Apollyon
apple apple
aramil aramil
Archos Archos
Ares Ares
Argan Argan

I understand this may be complicated... but any help would be appreciated...
I tried to set up conditional formating, and using the if statement, but
nothing does this automatically...

Thx for your help

 

[Executor]

Hi TroyT,

I have cooked something for you:

Sub InsertCells()

Range("A2").Select ' or any other cell to start

Do
Select Case StrComp(ActiveCell.Value, ActiveCell.Offset(0,
1).Value, vbTextCompare)
Case 1
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Cut Destination:=ActiveCell.Offset(1, 0)
ActiveCell.Interior.Color = vbGreen
Case -1
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0,
1).End(xlDown)).Select
Selection.Cut Destination:=ActiveCell.Offset(1, 0)
ActiveCell.Interior.Color = vbRed
ActiveCell.Offset(0, -1).Select
Case 0
End Select
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell) Or IsEmpty(ActiveCell.Offset(0, 1))
End Sub

Hoop This Helps,

Executor

 

[Guest]

Ok So i plugged this in, and we are on the right path.... And for that I
thank you...

But when it starts to do the formating it goes down the list and finds where
they dont align... and at that point it is supposed to insert a blank space
on the side where one name doesnt exist... it is basically doing it backward
right now... for example:
Column A Column B
284670004 284670004
3k5 test
A BRANCH 3k5
A2D2 A BRANCH
AAZZA A2D2
AbidikGubidi AAZZA

At row 2 there is an error as the two sides dont match up, the list is
supposed to insert a blank space where the "3k5" is (thus moving the current
3k5 down..) Right now the macro inserts a new cell ABOVE the word test and
moves it down until the next error.... (and fills with red)...

Basically I only need one cell inserted, and switched to the other side...
Hope i did not confuse you too much... But otherwise this is like 98% done!
This will save me about 5hrs a day! 4 times a week...

Thx again!

 

[Executor]

Hi TroyT,

I asummed that both colmuns were sorted.
If they are not, there has more to be done.
I will look some more into it ASAP.

Executor

 

[Guest]

Hello,
Yes both columns are sorted alphabetically, but the list on the right side
gets name added into it (few at a time) and also looses some compared to the
list on the left... Thats the reason I need the macro... I have other
information located in adjacent cells which can easily be formatted once
these listslign up, and have blank spot where name are missing...

 

[Executor]

Hi,

If the values to the right of these 2 columns have reverance to the
left column
sort only the right of these 2.
otherwise select all columns including the right one which are
reveranced to the right column and sort
things.

Start the macro.


Executor

 

[Guest]

I understand what your saying above, but they are both sorted rpior to using
the macro. Thats not the problem. When your macro is started it finds the
first "error" in the list comparison, and from the point it inserts a blank
cell all the way down to the next error. I only need one blank cell for each
error...

Thx

 

[Executor]

Hi TroyT

New version:

Sub InsertCells()
Dim lngRow As Long
Dim rngHold As Range

Range("A2").Select

Do
If StrComp(ActiveCell.Value, ActiveCell.Offset(0, 1).Value,
vbTextCompare) <> 0 Then
Set rngHold = ActiveCell
lngRow = 1
Do While StrComp(ActiveCell.Value,
ActiveCell.Offset(lngRow, 1).Value, vbTextCompare) <> 0 And (Not
IsEmpty(ActiveCell.Offset(lngRow, 1)))
lngRow = lngRow + 1
Loop
If IsEmpty(rngHold.Offset(lngRow, 1)) Then
lngRow = 1
Do While StrComp(rngHold.Offset(lngRow, 0).Value,
rngHold.Offset(0, 1).Value, vbTextCompare) <> 0 And (Not
IsEmpty(ActiveCell.Offset(lngRow, 1)))
lngRow = lngRow + 1
Loop
If IsEmpty(rngHold.Offset(lngRow, 0)) Then
If IsEmpty(rngHold.Offset(1, 0)) Then
rngHold.Cut Destination:=rngHold.Offset(1, 0)
Else
Range(rngHold, rngHold.Offset(lngRow,
1)).Select
Selection.Cut Destination:=rngHold.Offset(1, 0)
rngHold.Offset(0, 1).Cut
Destination:=rngHold.Offset(-1, 1)
End If
rngHold.Offset(-1, 0).Interior.Color = vbRed
rngHold.Offset(0, 1).Interior.Color = vbGreen
Else
If IsEmpty(rngHold.Offset(1, 1)) Then
Range(rngHold.Offset(0, 1), rngHold.Offset(0,
1)).Select
Else
Range(rngHold.Offset(0, 1), rngHold.Offset(0,
1).End(xlDown)).Select
End If
Selection.Cut Destination:=rngHold.Offset(lngRow,
1)
Range(rngHold.Offset(0, 1), rngHold.Offset(lngRow -
1, 1)).Interior.Color = vbGreen
End If
Else
If IsEmpty(rngHold.Offset(1, 0)) Then
Range(rngHold, rngHold).Select
Else
Range(rngHold, rngHold.End(xlDown)).Select
End If
Selection.Cut Destination:=rngHold.Offset(lngRow, 0)
Range(ActiveCell, ActiveCell.End(xlDown).Offset(-1,
0)).Interior.Color = vbRed
End If
rngHold.Select
End If

ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell) Or IsEmpty(ActiveCell.Offset(0, 1))
End Sub


Goodluck

Executor

 

[Guest]

WOOOHOOOO!! YES! Your Great! A+ This is SO Fast, and works excellent!