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

"Sharon" wrote:

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