Match and Sort Text in Two Columns in MS EXCEL

Match and Sort Text in Two Columns in MS EXCEL

 Sub LarsSort()  
   Dim lngColA As Long  
   Dim lngColC As Long  
   Dim rngColC As Range  
   Dim varColC As Variant  
   Dim i As Long  
   ' How many rows in column A?  
   lngColA = Range("A" & Rows.Count).End(xlUp).Row  
   ' For each item in column A, see if there is a match in column C  
   For i = 1 To lngColA  
     On Error Resume Next  
     Set rngColC = Columns(3).Find(What:=Range("A" & i).Value, After:=Range("C" & i), LookIn:=xlValues, _  
       LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)  
     On Error GoTo 0  
     If rngColC Is Nothing Then  
       ' No match. Move the contents of column C to the end (if there is a value)  
       If Range("C" & i).Value <> "" Then  
         Range("C" & (WorksheetFunction.Max(Range("C" & Rows.Count).End(xlUp).Row, lngColA) + 1)).Value = Range("C" & i).Value  
         Range("C" & i).Value = ""  
       End If  
     Else  
       ' Match. Swap contents  
       varColC = Range("C" & i).Value  
       Range("C" & i).Value = rngColC.Value  
       rngColC.Value = varColC  
     End If  
   Next  
   ' To tidy up, remove blanks from the non-matched items in column C  
   lngColC = Range("C" & Rows.Count).End(xlUp).Row  
   If lngColC > lngColA Then ' there are more unmatched items  
     For i = lngColC To lngColA + 1 Step -1  
       If Range("C" & i).Value = "" Then  
         Range("C" & i).Select  
         Selection.Delete Shift:=xlUp  
       End If  
     Next  
   End If  
 End Sub