'The following may or may not eventually be put into web pages

Sub Join()
  'David McRitchie  08/05/1998 not yet documented in
  '  http://www.mvps.org/dmcritchie/excel/excel.htm
  'Join cells in selected portion of a row together
  'can be used as a reversal of Data/Test2cols or SepTerm()
  Application.ScreenUpdating = False
  On Error Resume Next
  iRows = Selection.Rows.Count
  Set lastcell = cells.SpecialCells(xlLastCell)
  mRow = lastcell.Row
  If mRow < iRows Then iRows = mRow 'not best but better than nothing
  iCols = Selection.Columns.Count
  For ir = 1 To iRows
     newcell = Trim(Selection.Item(ir, 1).Value)
     For ic = 2 To iCols
       trimmed = Trim(Selection.Item(ir, ic).Value)
       If Len(trimmed) <> 0 Then newcell = newcell & " " & trimmed
       Selection.Item(ir, ic) = ""
     Next ic
     Selection.Item(ir, 1).Value = newcell
  Next ir
  Application.ScreenUpdating = True
End Sub
Sub SepTerm()
  'David McRitchie  08/05/1998  not yet documented in
  '  http://www.mvps.org/dmcritchie/excel/excel.htm
  'Separate the first term from remainder, as in separating
  'street number as first item from street & remainder
  'Work on first column, cell to right must appear to be blank
  '--Application.ScreenUpdating = False
  'On Error Resume Next
  iRows = Selection.Rows.Count
  Set lastcell = cells.SpecialCells(xlLastCell)
  mRow = lastcell.Row
  If mRow < iRows Then iRows = mRow 'not best but better than nothing
  For ir = 1 To iRows
       'If Len(Trim(Selection.Item(ir, 1).Offset(0, 1))) <> 0 Then MsgBox Selection.Item(ir, 1).Offset(0, 1)
       If Len(Trim(Selection.Item(ir, 1).Offset(0, 1))) <> 0 Then
          iAnswer = MsgBox("Found non-blank in adjacent column -- " _
             & Selection.Item(ir, 1).Offset(0, 1) & " -- in " & _
             Selection.Item(ir, 1).Offset(0, 1).AddressLocal(0, 0) & _
             Chr(10) & "Press OK to process those than can be split", vbOKCancel)
          If iAnswer = vbOK Then GoTo DoAnyWay
          GoTo terminated
       End If
  Next ir
DoAnyWay:
  For ir = 1 To iRows
       If Len(Trim(Selection.Item(ir, 1).Offset(0, 1))) <> 0 Then GoTo nextrow
       checkx = Trim(Selection.Item(ir, 1))
       L = Len(Trim(Selection.Item(ir, 1)))
       If L < 3 Then GoTo nextrow
       For im = 2 To L
          If Mid(checkx, im, 1) = " " Then
             Selection.Item(ir, 1) = Left(checkx, im - 1)
             Selection.Item(ir, 1).Offset(0, 1) = Trim(Mid(checkx, im + 1))
             GoTo nextrow
          End If
       Next im
nextrow:
  Next ir
  '--Application.ScreenUpdating = True
terminated:
End Sub


Sub Reversi()
  'David McRitchie  07/30/1998  not yet documented in
  '  http://www.mvps.org/dmcritchie/excel/excel.htm
  'Reverse  Item values in Range, Row, or Column   [Ctrl+R]
  'Items are counted proceeding down first column and
  'continues top of range in next column.
  'NOT RECOMMENDED WHEN FORMULAS ARE INVOLVED.
  tCells = Selection.Count
  mCells = tCells / 2
  For iX = 1 To mCells
     iValue = Selection.Item(iX)
     oX = tCells + 1 - iX
     Selection.Item(iX) = Selection.Item(oX)
     Selection.Item(oX) = iValue
  Next iX
End Sub

Sub Macro4()
    ' David McRitchie  about July 28, 1998
    'Will take current selection in a column, copy
    'and paste it to the 6 columns to the
    'right and sort the pasted column
    ' -- Range("A1:A10").Select

    'Copy current selection to clipboard
    Selection.Copy

    'make selection one column to right
    Selection.Offset(0, 6).Select

    'Paste into the selection
    'ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False

    'sort the selection
    Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
        xlTopToBottom
End Sub