Thread: Sorting error
View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.misc
Daminc
 
Posts: n/a
Default Sorting error


I thought I'd put in the completed solution here in case it might help
someone else:



Code:
--------------------
Sub find_duplicates()
'
' find_duplicates Macro
' Macro recorded 07/07/2005 by PreeceJ
'

'
Application.Run "'Validation sheet.xls'!sort_for_duplicates"
Range("K1").Select
Application.Run "'Validation sheet.xls'!FindDups"
End Sub



Sub sort_for_duplicates()
'
' sort_for_duplicates Macro
' Macro recorded 07/07/2005 by PreeceJ
'

Range("K:K").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Sort Key1:=Range("K1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("'Validation sheet.xls'!saleID").Select

'The saleID range I've put in as a dynamic range on the excel sheet
'InsertNameDefine
'Type in the name of the range (in this case saleID)
'In the box "Refers to" type in
' =OFFSET(worksheetname!$K$1,0,0,COUNTA(worksheetnam e!$K$1:$K$65),1)
'(change the name and range to suit your needs)

Application.Run "'Validation sheet.xls'!ConvertToNumbers"

Selection.Sort Key1:=Range("K1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

End Sub


Sub ConvertToNumbers()

Range("n1") = 1
Range("n1").Copy
Selection.PasteSpecial Paste:=xlAll, Operation:=xlMultiply, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("n1") = ""
With Selection
.VerticalAlignment = xlTop
.WrapText = False
End With

End Sub


Sub FindDups()
'
' NOTE: You must select the first cell in the column and
' make sure that the column is sorted before running this macro
'
ScreenUpdating = False
FirstItem = ActiveCell.Value
SecondItem = ActiveCell.Offset(1, 0).Value
Offsetcount = 1
Do While ActiveCell < ""
If FirstItem = SecondItem Then
ActiveCell.Offset(Offsetcount, 0).Interior.Color = RGB(255, 0, 0)
Offsetcount = Offsetcount + 1
SecondItem = ActiveCell.Offset(Offsetcount, 0).Value
Else
ActiveCell.Offset(Offsetcount, 0).Select
FirstItem = ActiveCell.Value
SecondItem = ActiveCell.Offset(1, 0).Value
Offsetcount = 1
End If
Loop
ScreenUpdating = True
End Sub
--------------------


hope this helps ;)


--
Daminc
------------------------------------------------------------------------
Daminc's Profile: http://www.excelforum.com/member.php...o&userid=27074
View this thread: http://www.excelforum.com/showthread...hreadid=530501