I also forgot to ask:

On the Highlight Duplicates macros, it highlights the entire row [ie:
Cells(y, 1).EntireRow.Interior.ColorIndex =4] I would like to change the
property EntireRow to just be the columns of the row that is the duplicate.
[ie: A:Q and S:AI].

I tried changing EntireRow to say Range("A:Q"), but it didn't like it. I'm
not sure what to say to change it.

Thanks again,

Sharon

"Vasant Nanavati" wrote:

Just copy the text of the FindAndReplace sub (except fot he Sub ... End Sub
part) and past it into the Sort sub at the end, before the End Sub line.
Then delete the FindAndReplace sub.

Repeat for the other 2 subs.

--

Vasant

"Sharon" wrote in message
...
Hello,

I have four macros that I would like to consolidate into two. The first
two
that should go together are the Sub Sort and Sub FindAndReplace. The
second
two that I would like to be one command are HighlightFcstDups and
HighlightObsDups.

Can someone show me how to consolidate?

Here's the code:

'I would like these two macros to be consolidated into one macro:

Public Sub Sort()
Application.ScreenUpdating = False
ActiveSheet.Columns("A:Q").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Key2:=Range("B1") _
, Order2:=xlAscending, Key3:=Range("C1"), Order3:=xlAscending,
Header:= _
xlNo, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal,
DataOption3:= _
xlSortNormal
ActiveWindow.SmallScroll ToRight:=18
ActiveSheet.Columns("S:AI").Select
Selection.Sort Key1:=Range("S1"), Order1:=xlAscending,
Key2:=Range("T1") _
, Order2:=xlAscending, Key3:=Range("U1"), Order3:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal,
DataOption3:= _
xlSortNormal
Application.ScreenUpdating = True
Range("a1").Select
End Sub


Public Sub FindAndReplace()
Application.ScreenUpdating = False
Dim oColors As Range
With Worksheets("1_Import")
Set oColors = Union(.Range("B1:Q400"), Range("T1:AI400"))

oColors.Replace What:="green", Replacement:="G", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
oColors.Replace What:="yellow", Replacement:="Y", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
oColors.Replace What:="red", Replacement:="R", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
oColors.Replace What:="no", Replacement:="NA", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Application.ScreenUpdating = True
End With
End Sub
----------------------------------------------------------------------

'These two macros I'd also like consolidated into one macro:

Sub HighlightFcstDups()

'Start at the currently selected cell
Range("a1").Select
x = ActiveCell.Row
y = x + 1

'Outside loop
Do While Cells(x, 1).Value < ""
'Inside loop
Do While Cells(y, 1).Value < ""
'Test for duplication:
'If the values of the third column (C) and the fifth column
(E)
match in two rows (this part of the code I edited)
'delete the second row of the pair, otherwise go to the next
row
until the end
If (Cells(x, 1).Value = Cells(y, 1).Value) Then

'FOR DUPLICATE DELETION: Uncommment the following line by
removing the apostrophe
'Cells(y, 3).EntireRow.Delete

'Shade the entire row green if it's a duplicate
'FOR DUPLICATE DELETION: Make the following line a comment
by adding an apostrophe
Cells(y, 1).EntireRow.Interior.ColorIndex = 4
Else

'FOR DUPLICATE DELETION: Uncomment the following line by
removing the apostrophe
'y = y + 1
End If

'FOR DUPLICATE DELETION: Make the following line a comment by
adding an apostrophe
y = y + 1
Loop
'increase the value of x by 1 to move the loop starting point to
the
next row
x = x + 1
'reset y so it starts at the next row
y = x + 1
Loop

End Sub

Sub HighlightObsDups()

'Start at the currently selected cell
Range("S1").Select
x = ActiveCell.Row
y = x + 1

'Outside loop
Do While Cells(x, 19).Value < ""
'Inside loop
Do While Cells(y, 19).Value < ""
'Test for duplication:
'If the values of the third column (C) and the fifth column
(E)
match in two rows (this part of the code I edited)
'delete the second row of the pair, otherwise go to the next
row
until the end
If (Cells(x, 19).Value = Cells(y, 19).Value) Then

'FOR DUPLICATE DELETION: Uncommment the following line by
removing the apostrophe
'Cells(y, 3).EntireRow.Delete

'Shade the entire row green if it's a duplicate
'FOR DUPLICATE DELETION: Make the following line a comment
by adding an apostrophe
Cells(y, 19).EntireRow.Interior.ColorIndex = 4
Else

'FOR DUPLICATE DELETION: Uncomment the following line by
removing the apostrophe
'y = y + 1
End If

'FOR DUPLICATE DELETION: Make the following line a comment by
adding an apostrophe
y = y + 1
Loop
'increase the value of x by 1 to move the loop starting point to
the
next row
x = x + 1
'reset y so it starts at the next row
y = x + 1
Loop

End Sub
--------------------------------------------------------------------------
--

Thanks for your help,

Sharon