Hi Mike and Chris,
I got Rng defined correctly, I just didn't tell you how to run macro.
My macros normally require a selection before running,
Makes macros much more flexible.
First make a selection, any of these but not a single cell
- entire contiguous rows
- entire worksheet (you can use Ctrl+A)
- entire column A
- contiguous selection of cells involving cells in Column A
Here is a modified version of the macro, to use Rng(1,1)
instead of ActiveCell which could get you messed up
and moving data to a different row.
Suggest first installing
TrimALL and SepLastTerm into your personal.xls from
http://www.mvps.org/dmcritchie/excel/join.htm#trimall
Sub PopulateAddr3Data()
'D.McRitchie, programming, 2004-08-29
'Data with less than six commas need more commas
Dim Cell As Range, CCnt As Long, i As Long, j As Long, insert As Long
Dim Rng As Range
Set Rng = Intersect(Selection, Columns("A:A"), ActiveSheet.UsedRange)
If Rng Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Selection.Replace What:=", TNT,", Replacement:="~ TNT", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
For Each Cell In Intersect(Rng, Rng)
CCnt = Len(Cell) - Len(Application.Substitute(Cell, ",", ""))
If CCnt < 6 And CCnt > 0 Then
insert = 6 - CCnt 'Insert = Left(",,,,,,,", 6 - CCnt)
i = 0: j = 0
While j < (CCnt - 2)
i = i + 1
If Mid(Cell.Value, i, 1) = "," Then j = j + 1
Wend
Cell.Value = Left(Cell.Value, i) & _
Left(",,,,,,,", insert) & Mid(Cell.Value, i + 1)
End If
Next Cell
'Text to Columns....
Rng.TextToColumns Destination:=Rng(1, 1), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), _
Array(5, 1), Array(6, 1), Array(7, 1))
Rng.Resize(, 7).Select
'-- tilde is an escape character for itself, so has to be doubled
Selection.Replace What:="~~ ", Replacement:=", ", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'-- See
http://www.mvps.org/dmcritchie/excel/join.htm#trimall
'-- invoke installed TrimALL code
Application.Run "'personal.xls'!Trimall"
'-- manually insert column before Column F, then before col B
'-- manually use SepLastTerm from join.htm on cells in A and in F
End Sub
Test Data used: at A14:A16 (United States shortened to USA for posting)
John Olson, 17 Elm St, Manchester, MA 01944, USA
Marlee Margulies, 400 Carona Place, Silver Spring, MD 20905, USA
Sam Linsky, TNT, 3500 W. Olive Ave., 15th Floor, Burbank, CA 91505,USA