Laurie Comerford and all, This routine supplied by Laurie looks like it would do exactly what I want, however it will not run for me. I'm getting a compile error: type mismatch on the line: "ThisDrawing.ActiveLayer = sLayerName" but from what i've read in help, this should have been ok (I'm rookie-rank) Here is the routine provided earlier. I changed the colorcode to be compatible with 2005 (I hope) and deleted a layer lineweight setting. Sub CreateTextLayer() On Error Resume Next Dim sLayerName As String Dim oLayer As AcadLayer Dim oEnt As AcadEntity Dim Pt(0 To 2) As Double Dim sNameExtension As String sNameExtension = "-TEXT" Do ' ThisDrawing.Utility.GetEntity oEnt, Pt, "Select object for '" & sNameExtension & "' layer creation" sLayerName = oEnt.Layer If InStr((UCase(sLayerName)), UCase(sNameExtension)) = 0 Then sLayerName = sLayerName & sNameExtension Set oLayer = ThisDrawing.layers.Add(sLayerName) ' You can set a whole range of layer features using the 'With' ' feature below. With oLayer .color = RGB(255, 0, 255) .Linetype = "CONTINUOUS" .Plottable = True End With ThisDrawing.ActiveLayer = sLayerName ' Option to move selected item to the layer if it is text of mtext If TypeOf oEnt Is AcadText Or TypeOf oEnt Is AcadMText Then oEnt.Layer = sLayerName End If End If Loop Until Err <> 0 ' Line above keeps code going till ' user presses <Esc> or fails to select an object. MsgBox "No object selected, finishing program run" End Sub