Rearranging Data in Columns

 

This page contains some VBA macros.  If you need assistance to install or to use a macro please refer refer to Install a Macro or User Defined Function  on my Formula page.

Many of the macros here are useful for reformatting name and address listings, and others for creating test data.  This document describes macros for

Join()

Joins selected columns on a row by row basis.  Reverse of SepTerm().

ReversI()

Reverses the items in a selection so that the first becomes the last, and the last becomes the first.

Lastname()

Put lastname before firstname, unless cell in the range already has a comma.

Firstname()

Put firstname before lastname, for cells with "Lastname, Firstnames".

FixUSzip5()

Fixup for 5 digit zip codes that have been stripped of first zero or show as a number

ReEnter()

Reenter the content in a cell.  Generally to activate things you have changed the underlying formats.  Also see TrimALL() to TRIM all cells in a selection, followed by RemoveAllSpaces to remove all spaces and char(160).

SepLastTerm()

Separate last word and place into next column.  Remainder remains in current column.  Reverse of Join.  much more restrictive than Data --> Text to Columns.  Concept is similar to SeptTerm().

Append a suffix to a value or formula to make a formula ReEnterSuff_F()

RotateCW()

Rotate Selected area A1:xxx clockwise

SepTerm()

Separate first word (term) from remainder.  Remainder goes to next column.  Reverse of Join.  much more restrictive than Data --> Text to Columns.

Sep3Terms()

Separate lastname, firstnames into 3 entities:  Firstname | Middlenames | Lastname.

The above macros do not actually destroy data, and can be reversed out (subject to some restrictions). 

Some additional worksheet function and macro usage

Rearrangements based on comma

Replace strings in a macro (ReplaceCRLF)

Use of REPT worksheet function, REPT repeats text a given number of times.

The following macro can be used to generate TEST data.

MarkCells()

Creates test data by placing the cells address as the value for each cell in the selected range.  Samples for this page.  i.e. A1,B1,C1,A2,B2,C2,C1,C2,C3.

FillSequence()

Creates test data by sequencial numbers into selected range(s).  i.e. 1,2,3,4,5,6,7,8,etc.

MarkSepAreas()

Creates text data across multiple ranges (areas) to create test data containing text value of cell address followed by the area number for each cell in the selected ranges.  i.e. A1-1, B1-1, B2-2,C2-2,D2-2

Some additional topics on this page

ReproduceActive

Reproduce Formula in ActiveCell to selected ranges(s)

Simple multiplication

and addition table examples.

Fill handle

used to fill cells by dragging current selection by the fill handle.

shortcut keys

Creating a sheet to document the builtin Excel shortcut keys.  (also how to add your own).

General Comments

Join Cells (reversal of Text to columns)

Join() can be used as a reversal of Text to Columns, and to reverse SepTerm() described later.  A range must be selected.  See Samples below for an example of usage.  Suggested shortcut key [Ctrl+j]

Sub Join()
  'David McRitchie  08/05/1998 [Ctrl+j] documented in
  '  http://www.mvps.org/dmcritchie/excel/join.htm
  'Join cells in selected portion of a row together
  'can be used as a reversal of Data/Test2cols or SepTerm()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  On Error Resume Next
  Dim iRows as Long, mRow as Long, ir as Long, ic as Long
  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.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

Lastname formatting

Lastname() can be used to rearrange cells so that lastname appears first in cells in selected range.  The range is for one column only.  If there is a comma in a cell, the cell will be left alone; otherwise, the cell will be recomposed with the word after the last space first followed by a comma, and the first names.  See Samples below for an example of usage. 

Sub Lastname()
  'David McRitchie  1999-04-09
  '  http://www.mvps.org/dmcritchie/excel/join.htm
  'Put cells in range in  as   Lastname, firstnames
  '--Application.ScreenUpdating = False
  'On Error Resume Next
  iRows = Selection.Rows.Count

  Set lastcell = cells.SpecialCells(xlLastCell)
  mrow = lastcell.Row
  If iRows > mrow Then iRows = mrow
  imax = -1
  For ir = 1 To iRows
       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 GoTo nextrow
          If Mid(checkx, im, 1) = " " Then imax = im
       Next im
       If imax > 0 Then
         Selection.item(ir, 1) = Trim(Mid(checkx, _
               imax, L - imax + 1)) & ", " & _
               Trim(Left(checkx, imax))
       End If
nextrow:
  Next ir
terminated:
  '--Application.ScreenUpdating = True
End Sub

Firstname before Lastname formatting

Switch selected cells from "lastname, firstnames" to "firstnames lastnames" based on having a comma in position 2 or higher.  This code is shorter and more efficient than the lastname macro because it was written later. 

Sub FirstName()
  'David McRitchie  2000-03-23 programming
  'http://www.mvps.org/dmcritchie/excel/join.htm#firstname
  Application.ScreenUpdating = False
  Application.Calculation = xlManual
  Dim cell As Range
  Dim cPos As Long
  For Each cell In Selection.SpecialCells(xlConstants, xlTextValues)
     cPos = InStr(1, cell, ",")
     If cPos > 1 Then
       origcell = cell.Value
       cell.Value = Trim(Mid(cell, cPos + 1)) & " " _
           & Trim(Left(cell, cPos - 1))
     End If
  Next cell
  Application.Calculation = xlAutomatic  'xlCalculationAutomatic
  Application.ScreenUpdating = False
End Sub

Worksheet formulas

A worksheet function solution maintaining two columns, one with the original data and one with the rearrangement.  You could, of course, eliminate the dependence with copy, the Edit, paste special, values and then eliminate the original column.  This converts "lastname, firstname" to "firstname, lastname"
    =TRIM(MID(B7,FIND(",",B7)+1,99))&" "&LEFT(B7,FIND(",",B7)-1)

Fix up for 5 digit US zip codes

US zipcodes are 5 digit or 9 digit (01234-1234) called zip+4.  Only the 5 digit zipcodes are a problem because they get interpreted as a number and get leading zeros stripped.  The fixUSzip5 subroutine will repair the damage generally introduced by the Text to Data wizard or by software converting a scanned image to an Excel file.  Canadian zip codes are unaffected because they are not numeric.  US zipcodes to not begin with two zeros, but a modication has been made for someone using 3 digit numbers for other countries and the Carribean.  After running macro suggest formatting the column as TEXT and remove any cell alignment.

Some worksheet formulas to help show what you actually have:
    =IF(ISTEXT(E2),"T",IF(ISNUMBER(E2),"N","L"))&LEN(E2)
    =personal.xls!GetFormat(E2)

Sub FixUSzip5()
   'David McRitchie  2000-04-28 notposted, updated 2001-12-14
   'http://www.mvps.org/dmcritchie/excel/join.htm#fixuszips
   Application.ScreenUpdating = False
   Application.Calculation = xlManual
   Dim cell As Range
   Dim cValue
   Dim cPos As Integer
   Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
     LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   'Trim in Excel removes extra internal spaces, VBA does not
   On Error Resume Next
   For Each cell In Selection.SpecialCells(xlConstants, 2)
     'trim text cells
     cell.Value = Application.Trim(cell.Value)
   Next cell   
   For Each cell In Selection.SpecialCells(xlCellTypeConstants, 1)
	   'special modification to also use 3 digits as if valid
     If Len(cell) = 4 Or Len(cell) = 5 Or Len(cell) = 3 Then
        cValue = cell.Value
        cell.NumberFormat = "@"
        cell.Value = Right("00000" & CStr(cell.Value), 5)
     End If
   Next cell
   Application.Calculation = xlAutomatic  'xlCalculationAutomatic
   Application.ScreenUpdating = False
End Sub

Worksheet solution for zip codes

[<100000]00000_-_0_0_0_0;[>0]00000-0000;;@

The underscores are reserving space on the right equivalent to a numeric digit.  All numeric digits in the same font have the same width by design. (see my formula page).

First 3 digits of zip codes, Worksheet Solution

Some zip code sortings require sorting on first 3 digits.  Your zipcodes should be text but if they are numbers then you will have a problem taking the left 3 digits, in which case something like the following will take care of mixed zipcodes as 5digit text, zip+4 text, or 5 digit numbers. The result will be 3 digit text entries.  This is a Worksheet solution.

   =IF(TRIM(A1)="","",IF(ISTEXT(A1),LEFT(A1,3),TEXT(INT(A1/100),"000")))

First group of characters for Canadian or UK zip codes

   =IF(ISERR(FIND(" ",A1)),A1,LEFT(A1,FIND(" ",A1)-1))

Reverse Cells in Selection end for end

ReversI() can be used to reverse the order of items in a row, column, or range.  It can be used to reverse itself.  Applied to a SINGLE ROW, the macro will flip about a vertical axis, or a horizontal axis for a column; otherwise, it really isn't a flip. Obviously you must select the range (i.e. A1:A30) and not the entire row or column.  If you selected an entire row for instance your data would be so far to the right that it would take you awhile to find it.  If you select a range of columns and rows the item in the upper left will reappear in the lower right corner.  What previously was ordered down will be up, and what ran left to right will run right to left.  You may notice the division by two; if the item count is not divisible by two the center item will not be switched.  Infrequent use does not justify a shortcut key.  See Samples below for an example of usage. 

Sub ReversI()
  'David McRitchie  07/30/1998 documented in
  '  http://www.mvps.org/dmcritchie/excel/join.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.
  Dim tCells as Long, iX as Long, oX as Long
  tCells = Selection.Count
  mCells = tCells / 2
  For iX = 1 To mCells
     iValue = Selection.Item(iX).Value
     oX = tCells + 1 - iX
     Selection.Item(iX).Value = Selection.Item(oX).Value
     Selection.Item(oX).Value = iValue
  Next iX
End Sub

Rotate Selection Clockwise

This Subroutine will Rotate the selection area A1:xnn 90 degrees ClockWise.  Because Rows are copy and pasted and because TRANSPOSE is used in this macro all formatting, and formulas are preserved.  See RotateCW() Sample in the Sample area.

Part 1, Rotate the Rows
Part 2, TRANSPOSE the rotated Rows for selection area -- Full rows

Note:  As written the selection area must include cell A1, and the original selection area is really the entire rows.  This is practical as long as there are not more than 256 rows selected because of the longstanding 256 column limitation in Excel.  This macro was written to normalize a spreadsheet that could best be views sideways and had rotated cells that became available in XL97.  Until rewritten arrangement or presence of cells not in selection is undefined.

Sub RotateCW()
  'Rotate Clockwise: 1) Rotate rows,  2) TRANSPOSE & delete orig
  'David McRitchie,  2000-02-07  MISC.,  documented in
  '  http://www.mvps.org/dmcritchie/excel/join.htm
  'Cell A1  must be in Selection !!!!!
  'must formatting and Formulas are preserved
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual   'pre XL97 xlManual
  Dim i As Integer
  Dim nRows As Integer
  Dim nCols As Integer
  Dim curRange As Range
  Dim abc As String
  Set curRange = Selection
  nRows = Selection.Rows.Count
  nCols = Selection.Columns.Count
  If nRows > 256 Then GoTo done
    nRows = InputBox("Specify number of rows, suggesting " & nRows, _
       "Selection of Number of rows to Rotate", Selection.Rows.Count)
  nRows = nRows + 1   'adjustment for inserts
  For i = nRows To 2 Step -1
    Rows(1).Select
    Selection.Cut
    Rows(i).Select
    Selection.Insert Shift:=xlUp
  Next i
  'Have flipped the rows, next step is to TRANSPOSE data with copy
  abc = "1:" & nRows - 1
  Range(abc).Select
  i = MsgBox("Flipping of Rows Completed. Do you want to continue " & _
    "with a TRANSPOSE using COPY?", vbOKCancel, "Question")
  If i <> 1 Then GoTo done
  Selection.Copy
  Cells(nRows, 1).Select   'TRANSPOSE  to
  Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
        , Transpose:=True
  Range(Cells(1, 1), Cells(nRows - 1, 256)).Delete
 done:
  Application.Calculation = xlCalculationAutomatic  'pre XL97 xlAutomatic
  Application.ScreenUpdating = True
End Sub

Separate first word (term) from remainder of cell

SepTerm() separates the first word (term) from remainder of cell.  Remainder goes to next column.  SepTerm() can be used as a reversal of Join and is a more forgiving option than Data --> Text to Columns.  SepTerm() Can be used to separate the street number from the rest of the street name.  Can also be used to separate a term from a definition.

Only a single column need to be selected.  The next column will be tested that it contains a blank.  A check will be made that no cells contain data in the adjacent column to the right, but you can override this.  Even after overriding data will not be split if it will remove content from the adjacent column.  See Samples below for an example of usage.  Suggested shortcut key [Ctrl+t]

Sub SepTerm()
  'David McRitchie  08/05/1998 [Ctrl+t]  documented in
  '  http://www.mvps.org/dmcritchie/excel/join.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
          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
  terminated:
    '--Application.ScreenUpdating = True
End Sub

Considerations in working with data from HTML sources
The macro above does not include replacing a non breaking space character (&nbsp;) typically used in HTML, with a normal space.  You can achieve the replacement with Worksheet
    Ctrl+H, Replace: Alt+0160, With: (space)
with macro code.
    Selection.Replace What:=CHR(160), Replacement:=CHR(32), LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False

A worksheet solution for the above. This will leave the original column and the two new columns wns will be dependent on the original.  You can remove the dependency by using copy and paste special value.  That's why I use a macro.

     =LEFT(A3,FIND(" ",A3)-1)
     =MID(A3,FIND(" ",A3)+1,LEN(A3)-FIND(" ",A3))

or to include considerations for char(160) but not errors (Peo Sjoblom, misc, 2002-02-17) -- No consideration for errors is all the more reason to use macros.

for street numbers (leftmost word):
=LEFT(TRIM(CLEAN(SUBSTITUTE(A1,CHAR(160)," "))),SEARCH(" ",TRIM(CLEAN(SUBSTITUTE(A1,CHAR(160)," "))))-1)

for street names (remainder):
=RIGHT(TRIM(CLEAN(SUBSTITUTE(A1,CHAR(160)," "))),LEN(TRIM(CLEAN(SUBSTITUTE(A1,CHAR(160),
     " "))))-SEARCH(" ",TRIM(CLEAN(SUBSTITUTE(A1,CHAR(160)," ")))))

VBA for Text to Columns  Macros on this page were written to reduce or eliminate the exposure of overwriting that would occur with the following Text to Columns.

     Selection.TextToColumns Space:=True, ConsecutiveDelimiter:=True

Reenter the cell current cell content

The formula may be reentered by hitting F2 (activate cell and formula bar) then Enter, which is fine for individual cells.  Another manual technique is the Replace (Ctrl+H) all equal signs (=) by equal signs.  Hitting F9 (Recalculate) will cause a reevaluation based on what is left, if done from the formula bar with highlighted text.

ReEnter() renters the content of cell.  Useful for such things as dates coming in from csv file that were not accepted as dates but have date content.  if using F2 and Enter will speed up the process this will be faster.  Also see my datetime page.

Sub ReEnter()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual  'pre XL97 xlManual
   Dim cell As Range
   Dim ix as Long
   tCells = Selection.Count
   For ix = 1 To tCells
       Selection.Item(ix).Formula = Trim(Selection.Item(ix).Formula)
   Next ix
  Application.Calculation = xlCalculationAutomatic  'pre XL97 xlAutomatic
  Application.ScreenUpdating = True
End Sub

and the opposite, to make formulas into text.  Also see GetFormula() on my Formula page.

Sub ReEnterVV()
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual  'pre XL97 xlManual
   Dim cell As Range
   For Each cell In Selection.SpecialCells(xlFormulas)
       cell.Value = "'" & cell.Formula
   Next cell
   Application.Calculation = xlCalculationAutomatic  'pre XL97 xlAutomatic
   Application.ScreenUpdating = True
End Sub

To convert formula values to value constants.  Also see GetFormula() on my Formula page.

Sub ReEnterF2V()
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual  'pre XL97 xlManual
   Dim cell As Range
   For Each cell In Selection.SpecialCells(xlFormulas)
       cell.Value = "'" & cell.value
   Next cell
   Application.Calculation = xlCalculationAutomatic  'pre XL97 xlAutomatic
   Application.ScreenUpdating = True
End Sub

The following will Trim all constants in the selection.  The use of SpecialCells prevents truly empty (ISBLANK) cells from being processed.  CHR(160) is the non breaking space character (&nbsp;) in HTML which will be included by changing them first to normal spaces.  There is a difference between TRIM in Excel and in VBA.  Excel will reduce internal spaces, VBA will not.  Use Trim(Cell.value) if you prefer the VBA method.  Other characters you may see are TAB, CR, LF which have decimal values of 09, 13, and 10. 

You can check an individual cell with =LEN(C2) and =CODE(LEFT(C2)) and =CODE(MID(C2,LEN(C2),1)) if you experience some problems in your data.

Sub TrimALL()
   'David McRitchie 2000-07-03 mod 2000-08-01
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Dim Cell As Range
   'Also Treat CHR 0160, as a space (CHR 032)
   Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
     LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   'Trim in Excel removes extra internal spaces, VBA does not
   For Each Cell In Selection.SpecialCells(xlConstants)
     Cell.Value = Application.Trim(Cell.Value)
   Next Cell
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
End Sub

The following code will Remove all Spaces from the selected area.  Compare to TrimAll immediately above.

Sub RemoveAllSpaces()
'David McRitchie 2000-10-24
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Selection.SpecialCells(xlConstants).Replace What:=Chr(160), _
        Replacement:="", _
        LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True
    Selection.SpecialCells(xlConstants).Replace What:=Chr(32), _
        Replacement:="", _
        LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Code to convert Text dates in a column to Dates can be found on DateTime page

Append suffix to value or formula

The ReEnterSuff_F macro will generate formulas, regardless of whether you started with formulas or not.  Default suffix will be taken from cell c1, which you can override.  Original content will be enclosed in parentheses if the suffix begins with a left paren.  Errors will be ignored.
  - to ignore range if no formulas in entire range
  - to ignore range if no constants in entire range
  - to ignore anything that would result in an incorrect formula

Sub ReEnterSUFF_F()
   Application.ScreenUpdating = True
   Application.Calculation = xlCalculationAutomatic
   'David McRitchie 2000-06-24 misc, join.htm in www.mvps.org/dmcritchie/excel/
   ' Formulas will result
    Dim cell As Range
    Dim mySuff As String
    Dim myPref As String
    mySuff = InputBox("Provide suffix   i.e. *(1+$b$1) or )*(1+$B$1)", _
       "ReEnterSuff:  Supply formula suffix", [c1])
    If mySuff = "" Then GoTo done
    If Left(mySuff, 1) = ")" Then
       myPref = "("
    Else
       myPref = ""
    End If
    On Error Resume Next
    For Each cell In Selection.SpecialCells(xlFormulas)
        cell.Formula = "=" & myPref & Mid(cell.Formula, 2) & mySuff
    Next cell
    For Each cell In Selection.SpecialCells(xlConstants)
        cell.Formula = "=" & myPref & cell.Formula & mySuff
    Next cell
  done:
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
End Sub

Separate Last word (term) from remainder of cell

SepLastTerm() separates the last word (term) from remainder of cell.  Last word goes to next column, first portion replaces current cell.  SepLastTerm() can be used as a partial reversal of Join and is a more forgiving option than Data --> Text to Columns.  SepLastTerm() Can be used to separate the first names from the lastname.

Another frequent use would be to separate the zip or zip+4 code from a column containing City, State and zipcode.  Because zip codes can be 5 digits only and can begin with a zero you should format the column to the right as TEXT before invoking the SepLastTerm macro.

Only a single column need to be selected.  The next column will be tested that it contains a blank.  A check will be made that no cells contain data in the adjacent column to the right, but you can override this.  Even after overriding data will not be split if it will remove content from the adjacent column.  See Samples below for an example of usage.  See Considerations for HTML non-breaking-space (&nbsp;) Suggested shortcut key [Ctrl+t]

Sub SepLastTerm()
  'David McRitchie  08/20/1998 [Ctrl+l] documented in
  '  http://www.mvps.org/dmcritchie/excel/join.htm
  'Separate the last term from remainder, as in separating
  'lastname from firstname
  'Work on first column, cell to right must appear to be blank
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual 'pre XL97 xlAutomatic
  'On Error Resume Next
  Dim iRows as Long, mRow as Long, ir as Long
  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
          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
       '-- this is where SepLastTerm differs from SepTerm
       For im = L - 1 To 2 Step -1
          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
terminated:
  Application.Calculation = xlCalculationAutomatic  'pre XL97 xlAutomatic
  Application.ScreenUpdating = True
End Sub

Notes for separating zipcodes: Format the column ahead of time as text; otherwise, you will experience 4 and 5 digit numbers sorted as numbers without leading zero and appearing ahead of text entries of nine digit numbers with hyphens.  Numbers sort before text.  When sorting be sure to select all of the columns involved not just the columns to be sorted on (Data-->Sort)  I will create some MailMerge documentation at a future date look for it in the index.  Meanwhile some steps are data resides in Excel spreadsheet and columns have headings.  Start blank (new) word document, Tools --> Mail Merge --> labels etc. haven't done it yet.

Notes for separating City, State, zipcode:  Some cities have more than one word in their names, and some states have more than one word in their names, so Text to Columns may not work for your data.

If you have state names spelled out instead of two letter zip state coding, first change "New " to "New_" in the column to be split up, also use the underscore to combine Washington D.C. , if present into one word.

and then split from the right using SepLastTerm (above) into an inserted empty column to split off the zip code, repeat to split off the state, hopefully you are done after resubstituting underscore for a space in the city and state columns.

Some Worksheet Solutions equivalent to SepLastTerm

• AN=587462062 David Hager, 2000/02/19
  This is an Array Formula.  Hold down the Ctrl and Shift keys when entering this formula.  The formula can be replicated down using the fill-handle.

  =MID(A1,MAX((MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1)=" ")*ROW(INDIRECT("1:"&LEN(A1))))+1,255)
  

• AN=587474402 George Simms, 2000/02/19 (doesn't work for my test get #VALUE!)

  =RIGHT(A2,MATCH(" ",MID(A2,LEN(A2)-ROW(INDIRECT("1:"&LEN(A2))),1),0))
  

• AN=587474402 Chip Pearson has a webpage First and Lastnames none of the examples match SepLastTerm though.

Some additional worksheet function and macro usage

Rearrangements based on comma

Retaining an alphabetized listing as lastname, first names probably makes the most sense, as long as only a single comma is used.  This allows for sorting of names.  A simple rearrangement is possible then with a function or macro.

The following worksheet solution was posted by Tom Ogilvy to split text at first comma to utilize the portion after the comma as a new sort field.

     =RIGHT(A12,LEN(A12)-FIND(",",A12))

This is set up to work on the address in cell A12.  To remove the space after the comma also

     =RIGHT(A12,LEN(A12)-FIND(",",A12+1))

Then drag fill this formula down the column.

Solutions to converting  “Williams, John B.” to “John B. Williams”.  The one with TRIM works because it can handle zero or more spaces after the comma.

     =MID(A2,FIND(",",A2)+2,LEN(A2)-FIND(",",A2))&" "&LEFT(A2,FIND(",",A2)-1)

     =MID(A2,FIND(",",A2)+2,255) & " " & LEFT(A2,FIND(",",A2)-1)

     =TRIM(MID(A2,FIND(",",A2)+1,255) & " " &LEFT(A2,FIND(",",A2)-1))

Worksheet solution to split at a comma removing any space immediately after the comma.

A12:   Van Leeuwen,   Joseph H.
B12:   =LEFT(A12,FIND(", ",A12)-1)
C12:   =TRIM(RIGHT(A12,LEN(A12)-FIND(",",A12)))

REPLACE in a macro

You might want to make a global replacements in selected cells similar to Ctrl+H, such as removal of commas.  The following code removes Carriage Return (x'0D') and Line Feed (x'0A') from the selected range.  Tab is x'09'. 

For more information see Excel HELP --> Index --> Visual Basic Code --> Worksheet Functions

Sub ReplaceCRLF()
  'Bill Manville  Thu, 4 Feb 1999
  Selection.Replace Chr(13)," ",xlPart    'x1Part apply to within cells (default)
  Selection.Replace Chr(10)," ",xlPart    'xlWhole apply to entire cell content
End Sub

REPT Worksheet Function

REPT repeats text a given number of times, in the example below spaces are repeated.  Use of REPT was suggested by Thomas Ogilvy (08/05/1998) as a means of sorting the numeric street numbers utilizing a separate column.  At first I thought it didn't sort when I attempted to sort on the single column without including the column refered to -- after all it was only test data and I didn't care whether it remained intact or not.  These extra spaces can only be seen properly in a fixed font such as "Courier".  For sorting you might consider also making the street fixed length and have it sort before the numeric portion.

VAL Function in VBA

Function NumVal(n) As Double NumVal = VAL(n) 'obtains leading number value ' -- Dana DeLouis 2000-11-29 End Function

123abc678  Result -->  123  A112  Result --> 0  12 a 67 b 12  Result --> 12  12  45  Result --> 1245

Extract numbers from a cell

One way, put the below formula in B1 if "AB12FG" is in cell A1, copy it down as long as needed. Peo Sjoblom <terre08@mindspring.com> 2001-07-09 in worksheet.functions

=MID(A1,MATCH(FALSE,ISERROR(1*MID(A1,ROW(INDIRECT("1:10")),1)),0),10-SUM(1*ISERROR(1*MID(A1,ROW(INDIRECT("1:10")),1))))*1

Testing Things on This Web Page

MarkCells() will destroy previous contents within invoked RANGE.  Each cell will be identified with it's address when MarkCells was invoked.  The examples in Samples below, and in Delete Cells/Rows in Range, based on empty cells utilized MarkCells.  Some similar items of interest are AAA_ZZZ macro will generate AAAA up to ZZZZ within a selected range(s).  Also of interest is a UDF by Myrna Larson that increments strings See related area below.

Suggested Toolbar menu item [Mark cells with cell address]

Sub MarkCells()
  'David McRitchie 07/17/1998 [Mark cells with cell address] Documented
  'with Join() in http://www.mvps.org/dmcritchie/excel/join.htm
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  '--Dim iX as Long
  '--For iX = 1 To Selection.Count   '(0,0) below is same as (False, False)
  '--   Selection.Item(iX) = "'" & Selection.Item(iX).AddressLocal(0, 0)
  '--Next iX
  Dim cell As Range
  For Each cell In Selection   '(0,0) below is same as (False, False)
     cell.Value = "'" & cell.AddressLocal(0, 0)
  Next cell
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

   For Each Cell In Selection
     Cell.Value = "'" & Cell.AddressLocal(0, 0)
   Next Cell

Cells are ordered left to right, next row -- left to right, etc.  You can have multiple selection ranges in Excel 2000.  If the ranges overlap you will have missing numbers as each range is filled in in the order it was selected and filled in before continuing to the next range.

 

Suggested Toolbar menu item [Fill Sequence 1-2-3] Sub FillSequence() Dim cell As Range Dim i As Long For Each cell In Selection i = i + 1 cell.Value = i Next cell End Sub

A B C D E 1           2   1 2     3   3 4     4   5 9 10   5   7 11 15 16 6     13 17 18 7   22   19 21 Colors depict multiple ranges

      =CELL("address",c14)           Displays as $C$14
      =CELL("address",offset(c14,-1,0))
      =ADDRESS(14,3)      equals "$C$14", relative form available with 4 as 3rd
      =ADDRESS(ROW(C14),COLUMN(C14),4)   equals "C14" operand

Sub MarkSepAreas()
'David McRitchie 06/03/1999 Mark cells with cell address and
'area number.  Enhanced based on Alan Beban code Jun 3, 1999.
'Documented with Join()
'in http://www.mvps.org/dmcritchie/excel/join.htm
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Long, j As Long
For i = 1 To Selection.Areas.Count
  For j = 1 To Selection.Areas(i).Count
    Selection.Areas(i)(j).Value = "'" _
       & Selection.Areas(i)(j).AddressLocal(0, 0) & "-" & i
  Next
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

F2-1
	G3-2
		H4-3	I4-3
		H5-5	I5-4
		H7-6	I7-7
		H9-8	I9-8

Filling in Cell Comments for Testing

Propagation using the Fill Handle

Fill in a series for a growth trend   (from HELP --> wiz --> fill handles)
1 Select at least two cells that contain values on which you want to base the trend.
2 Hold down the right mouse button and drag the fill handle in the direction you want to fill.
3 Release the mouse button and then click Growth Trend on the shortcut menu.

Transpose data in Column A to Row 1 for titles

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

1

A1

A1

A2

A3

A4

A5

A6

A7

A8

A9

A10

A11

A12

A13

A14

A15

A16

A17

A18

A19

A20

A21

2

A2

3

A3

Sub TransposeColumnA() 'David McRitchie, 2000-11-30 misc, ' http://www.mvps.org/dmcritchie/excel/join.htm Range("A1").Activate Cells(Rows.Count, ActiveCell.Column).End(xlUp).Select Range("A1", ActiveCell.Address).Copy Range("B1").Select Selection.PasteSpecial Paste:=xlAll, _ Operation:=xlNone, SkipBlanks:=False, _ Transpose:=True Columns("A:A").Select Selection.Clear 'Clear and save to ActiveWorkbook.Save 'Correct lastcell location Range("A:A,1:1").Select Selection.Font.Bold = True Range("B2").Select End Sub Compare the first part of this macro to macro below found in:     http://www.mvps.org/dmcritchie/excel/toolbars.htm Sub GotoBottomOfCurrentColumn() 'Tom Ogilvy 2000-06-26 Cells(Rows.Count, ActiveCell.Column).End(xlUp).Select End Sub

4

A4

5

A5

6

A6

7

A7

8

A8

9

A9

10

A10

11

A11

12

A12

13

A13

14

A14

15

A15

16

A16

17

A17

18

A18

19

A19

Let the testing demonstration begin

1. Create a new worksheet
2. Select range a1:f25
3. Populate with data using MarkCells macro. Possibly with Toolbar menu item [Mark cells with cell address]
4. Rearrange items in list, select range a1:f20, invoke ReversI() macro.  Tools --> Macro --> (select ReversI) --> Run.
5. Restore orginal arrangement by reinvoking ReversI() with same range.
6. Select range a1:f25
7. Join columns into first selected column using Join(). Possibly invoked with shortcut key [Ctrl + j ].
8. Select range a1:a25.  Use Data --> Text to Columns to resplit columns.  Use delimited by Space.
9. Select range a1:c25.  Use Join.  With a little imagination the resulting format could be a street address (1082 Washington Blvd.), in fact you could change cell A1 to that if you like.
10. Select range a1:b25.  Use SepTerm().  Only the first column is actually used, the adjacent column to the right should be empty. 
11. Test is ended.  If you like you may select b1:b25 and invoke SepTerm()

Samples

Rotate Selection Area 90 degrees

Good Luck!  Happy EXCELing.

Text to Columns

Populating a Table based on number of rows and columns

Sub MultTable()
 noCols = InputBox("Number of columns")
 noRows = InputBox("Number of Rows")
 Dim ir as Long, ic as Long
 For ir = 1 To noRows
    For ic = 1 To noCols
        cells(ir, ic).Value = ir * ic
    Next ic
 Next ir
End Sub

The following example will generate an addition table starting at the currently active cell.

Sub AdditionTab() noCols = InputBox("Number of columns") noRows = InputBox("Number of Rows") Dim noCOls as Long, noRows as Long, ir as Long, ic as Long Dim ics as Long, irs as Long ics = ActiveCell.Column irs = ActiveCell.Row 'Starting at the active cell For ir = 0 To noRows - 1 For ic = 0 To noCols - 1 cells(ir + irs, ic + ics).Value = ir + ic Next ic Next ir End Sub

-C- -D- -E- -8- 0 1 2 -9- 1 2 3 -10- 2 3 4 -11- 3 4 5

Another approach to generate your Addition Table and Multiplication Table is to use the fill handle with formulas.
Addition Table starting in cell A1: =Row()-1+Column()-1
Multiplication Table starting in cell A1: =(Row()-1)*(Column()-1)

Separation of Lastname, Firstname middlenames

Sub Sep3Terms()  'David McRitchie  1999-03-11 will be documented in
  '  http://www.mvps.org/dmcritchie/excel/join.htm
  'Separate   lastname, firstname middlenames   into 3 entities
  '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))) + _
          Len(Trim(Selection.item(ir, 1).Offset(0, 2))) + _
          Len(Trim(Selection.item(ir, 1).Offset(0, 3))) <> 0 Then
          iAnswer = MsgBox("Found non-blank in adjacent 3 columns -- " _
             & 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:
   Application.ScreenUpdating = False
   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))
       Ipos = InStr(checkx, ",")
       If Ipos = 0 Then
          lastname = checkx
          firstnames = ""
       Else
          lastname = Left(checkx, Ipos - 1)
          firstnames = Trim(Right(checkx, Len(checkx) - Ipos))
       End If
       Ipos = InStr(firstnames, " ")
       If Ipos = 0 Then
          firstname = firstnames
          middlename = ""
       Else
         firstname = Left(firstnames, Ipos - 1)
         middlename = Right(firstnames, Len(firstnames) - Ipos)
       End If
       Selection.item(ir, 1).Offset(0, 1) = firstname
       Selection.item(ir, 1).Offset(0, 2) = middlename
       Selection.item(ir, 1).Offset(0, 3) = lastname
   Next ir
terminated:  Application.ScreenUpdating = True
End Sub

Chip Pearson also has a page on Working with First and Last Names: http://www.cpearson.com/excel/FirstLast.htm and another on parsing US style phone numbers.

Return string after last "/" character

=AFTLAST(E22)

Function AFTLAST(cell As Range, findchar As String) As String
Application.Calculation = xlCalculationManual          'in XL97
Dim i as Integer
For i = Len(cell) To 1 Step -1
    If Mid(cell, i, 1) = findchar Then
        AFTLAST = Mid(cell, i + 1, 99)
        Exit Function
   End If
Next i
AFTLAST = cell   ' or   aftlast=""  depending on what you want
Application.Calculation = xlCalculationAutomatic     'in XL97
End Function

Return string after first "/" character

    =IF(ISERR(FIND("/",E22)),E22,MID(E22,FIND("/",E22,1)+1,99))
or
    =IF(ISERR(FIND("/",E22)),"",MID(E22,FIND("/",E22,1)+1,99))
depending on whether you want cell value or nothing when "/" is not present.

Strip Left 2 characters from cells in Selected Range

Sub StripL2()
   'Strip left two positions from cell in selection range
   'SpecialCells will limit the range to the used area within
   Dim cell As Range
   For Each cell In Selection.SpecialCells(xlConstants)
      cell.Value = Mid(cell.Value, 3)
   Next cell
End Sub

Remove Excess hyphens in TEXT cells

  DCK-43V---
FS--4824--G3---
SWS---7224--S

Option Explicit
Sub REMXHYPS()
  'David McRitchie 2000-02-28   excel.programming
  'hyphen removals of dups, prefixed, suffixed, and trim results
  'updated based on George Clark's simpler
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual   'pre XL97 xlManual
  Dim temp As String
  Dim cell As Range
  For Each cell In Selection.SpecialCells(xlCellTypeConstants, 2)
    'above limits to constants which are TEXT
    If InStr(1, cell.Value, "-") Then   'Insure possibility of change
       temp = Trim(cell.Value)
       While InStr(temp, "--") > 0
          temp = Replace(temp, "--", "-")
       Wend
       If Right(temp, 1) = "-" Then temp = Left(temp, Len(temp) - 1)
       If Left(temp, 1) = "-" Then temp = Right(temp, Len(temp) - 1)
       cell.Value = Trim(temp)
    End If
 Next
 Application.Calculation = xlCalculationAutomatic  'pre XL97 xlAutomatic
 Application.ScreenUpdating = True
End Sub

Single Quote or prefix add/remove for text or for formulas

SQUOTE_Add will insert a single quote in front of a formula, rendering it as a comment.

Sub SQUOTE_add()
   'David McRitchie  2000-08-05 notposted
   'http://www.mvps.org/dmcritchie/excel/join.htm#squote
   Application.ScreenUpdating = False
   Application.Calculation = xlManual
   Dim cell As Range
   For Each cell In Intersect(Selection, ActiveSheet.UsedRange)
     If Len(Trim(cell)) > 0 Then _
        if left(cell.formula)="=" then cell.Value = "'" & cell.Formula
   Next cell
   Application.Calculation = xlAutomatic  'xlCalculationAutomatic
   Application.ScreenUpdating = False
End Sub

insertprefix will insert a prefix of your choice in front of TEXT, which is what you see as opposed to values, or formulas. 

Sub insertprefix()
   'David McRitchie  2000-08-05 posted
   'http://www.mvps.org/dmcritchie/excel/join.htm#squote
   Application.ScreenUpdating = False
   Application.Calculation = xlManual
   Dim cell As Range
   Dim myPrefix As String
   myPrefix = "'"
   myPrefix = InputBox("Supply prefix character(s)", "Supply prefix", myPrefix)
   For Each cell In Intersect(Selection, ActiveSheet.UsedRange)
     If Len(Trim(cell)) > 0 Then _
       cell.Formula = myPrefix & cell.Text
   Next cell
   Application.Calculation = xlAutomatic  'xlCalculationAutomatic
   Application.ScreenUpdating = False
End Sub

SQUOTE_Remove will remove a single quote in front of a formula, rendering it back as a formula.  The single quote cannot be detected by with cell.value nor with cell.formula, so there is a little trick used here with VarType(variable), where 8 indicates a string, see GetFormulaI on my Formula page.

Sub SQUOTE_remove()
   'David McRitchie  2000-08-05 notposted
   'http://www.mvps.org/dmcritchie/excel/join.htm#squote
   Application.ScreenUpdating = False
   Application.Calculation = xlManual
   Dim cell As Range
   For Each cell In Intersect(Selection, ActiveSheet.UsedRange)
     If VarType(cell) = 8 Then cell.Formula = cell.Formula
     'note the squote is not easily detectable
   Next cell
   Application.Calculation = xlAutomatic  'xlCalculationAutomatic
   Application.ScreenUpdating = False
End Sub

Reproduce Formula in ActiveCell to selected ranges(s)

Reproduce (copy) same formula unchanged to other selected cells in the sheet.

Since the active cell is the one that will get reproduced you should select it last if multiple ranges are selected.  In fact you can reselect ranges -- the duplication won't harm anything it will just take a little longer.  The active cell will be reentered but that won't matter.  Select multiple ranges with the help of the Ctrl key. In Excel 2000 the macro is very simple because Excel 2000 includes all separate ranges.  Prior to Excel 2000, one would have to cycle through the separate ranges.  Example of cycling through multiple ranges can be seen in the MarkSepAreas macro.

Sub reproduceactive() Dim activecellformula As String Dim cell As Range Dim x As Integer If Selection.Count > 100 Then x = MsgBox("Perhaps you don't really " _ & "want to do this for " _ & Selection.Count & " cells", _ vbOKCancel, "Reproduce active cell " _ & " through selection") If x <> 1 Then Exit Sub End If activecellformula = ActiveCell.Formula For Each cell In Selection cell.Formula = activecellformula Next cell End Sub example: A1: 'a1 B1: '--b1 F1: =A1 & B1 select multiple ranges: B3:F8, C10:E17, D1 invoke macro ReproduceActive

Addition of Prefixes and Suffixes

So far just have Make_INDIRECT for lack of a form that would be needed.

Make_INDIRECT will wrap =INDIRECT() around simple assignment statements so that you can refer to specific cells in another (data) sheet and not have things rearranged by insertion/deletions of the data sheet.
 =Sheet1!A3   becomes   =INDIRECT("Sheet1!A3")

Sub Make_INDIRECT()
   'David McRitchie  2000-10-12 notposted
   'http://www.mvps.org/dmcritchie/excel/join.htm#indirect
   Application.ScreenUpdating = False
   Application.Calculation = xlManual
   Dim cell As Range
   On Error Resume Next
   For Each cell In Intersect(Selection, ActiveSheet.UsedRange)
     If Left(cell.Formula & " ", 1) = "=" Then
       If Left(cell.Formula, 10) <> "=INDIRECT(" Then
        If InStr(1, cell.Formula, "!", 0) Then
          If InStr(1, LCase(cell.Formula), "getformula", 0) = 0 Then
            cell.Formula = "=indirect(""" & _
                Mid(cell.Formula, 2, 9999) & """)"
          End If
        End If
       End If
     End If
   Next cell
   Application.Calculation = xlAutomatic  'xlCalculationAutomatic
   Application.ScreenUpdating = False
End Sub

Remove Prefix

The following will remove Prefix from cells with TEXT content in a selection.

Sub Remove_Prefix()
  'David McRitchie 2001-08-27  excel.programming
  'prefix removal
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual   'pre XL97 xlManual
  Dim temp As String
  Dim cell As Range
  Dim xPre As String
  xPre = InputBox("Supply Prefix to be removed:", _
     "Prefix Removal", "401 1")
  If xPre = "" Then GoTo done
  On Error GoTo done
  For Each cell In Intersect(Selection, _
      Selection.SpecialCells(xlCellTypeConstants, 2))
    'above limits to constants which are TEXT
    If Left(cell.Value, Len(xPre)) = xPre Then
       cell.Value = Mid(cell.Value, Len(xPre) + 1)
    End If
 Next
done:
 Application.Calculation = xlCalculationAutomatic  'pre XL97 xlAutomatic
 Application.ScreenUpdating = True
End Sub

Create formulas in selected cells, with address substitution for word "cell"

The following would also work for the previous example of INDIRECT by changing the default entry. 

The following subject to modification would insert a link to book [ss.xls]'Sheet7'cell for a HYPERLINK and as a value, where cell would be substituted for the current cell address.

Sub InsertCellReplacement()
  'David McRitchie, misc, 2001-05-23
  ' http://www.mvps.org/dmcritchie/excel/join.htm
  Dim cell As Range
  Dim V As String, vv As String
  Dim i As Integer, j As Integer
  V = "=HYPERLINK(""[ss.xls]'sheet7'!cell"",[ss.xls]sheet7!cell)"
  V = InputBox("oportunity to change your formula" _
          & vbCR & "the word cell will be substituted with cell address", _
    "Your call is important to us", V, vbOKCancel)
  If V = "" Then GoTo terminate
  For Each cell In Selection
    vv = V
    For i = 1 To 3
       j = InStr(1, vv, "cell")
       If j = 0 Then GoTo vDone
       vv = Left(vv, j - 1) & cell.Address(1, 1) & Mid(vv, j + 4, 999)
    Next i
vDone:
    cell.Formula = vv
  Next cell
terminate:
End Sub

Cell addressing in VBA

Since there are several examples on this page, this seems about as good a place as any to include the following information.

Find the numeric column number equivalent for Column "AB". 

     MsgBox "Numeric equivalent for AB is " & Range("ab" & "1").Column

Find Column number of the selected cell or the last cell.

     Set lastcell = Cells.SpecialCells(xlLastCell)
     lRows = lastcell.Row
     lCols = lastcell.Column

     Row = activecell.row
     Col  = activecell.column

Find Column letters of the selected cell
Columns run A through IV (1-256), length is 1 for < 27, or 2 above 26.

    = Left(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2)

Even simpler is one from Dana DeLouis, 2001-03-04 in programming

    = Split(ActiveCell.Address, "$")(1)  'For Column Letter
    = Split(ActiveCell.Address, "$")(2)  'For Row Number

Finding the Relative Address of a cell.
Assumes you have A1 addressing:  Tools --> Options --> General --> with R1C1 off

Place address of cell into itself as a text entry -- see MarkCells example above.

   Selection.Item(iX) = "'" & Selection.Item(iX).AddressLocal(0, 0)

Followup example:

Sub test10()
   'will display CV as equivalent of 100, and 28 for AB
   C = 100
   MsgBox "Alpha equivalent for Col " & C & " is " & _
     Left(cells(1, C).AddressLocal(0, 0), _
     Len(cells(1, C).AddressLocal(0, 0)) - 1)
   MsgBox "Numeric equivalent for AB is " & Range("ab" & "1").Column
End Sub

Worksheet Example of converting column number to a Letter
Will convert numbers 1 to 256 to Excel column letters A to IV.

256  IV  =LEFT(ADDRESS(1,A1,4),LEN(ADDRESS(1,A1,4))-1)
  1  A   =LEFT(ADDRESS(1,A2,4),LEN(ADDRESS(1,A2,4))-1)
  2  B   =LEFT(ADDRESS(1,A3,4),LEN(ADDRESS(1,A3,4))-1)
  3  C   =LEFT(ADDRESS(1,A4,4),LEN(ADDRESS(1,A4,4))-1)

  4  D1  =ADDRESS(1,A5,4)  **ADDRESS(row,column)**

Shortcut Keys in Excel

Shortcuts are entirely optional.  A shortcut key can be assigned to a macro using: Tools --> Macro --> (select a macro) --> Options.  Excel will Warn you if you attempt to utilize a short cut key already in use -- it will change the form of assignment for instance.  You will have to remember them or write them down somewhere.  I highly recommend creating a sheet for your MS Excel installed shortcut keys so that you can use FIND to find a shortcut yourself.  You could even add your own at the bottom.  Also recommend creating another sheet for function keys.

More information on Viewing, Listing and Creating Shortcut Keys.

Related Items

How to install/use a macro can be found on my formula page.

Dates used in text usually relate to posting dates in Google Advanced Usenet Search for microsoft.public.excel* newsgroups.

• AAA_ZZZ macro, David McRitchie, creates a sequence of AAAA up to ZZZZ in the selected range.  Shows on Status Bar, and DoEvents to relinquish control to operating system during it's run.  Excel 2000 allows multiple ranges to be treated in order.   In the same thread Bernie Dietrich posted a worksheet formula that would increment from AAA to ZZZ.
• Combine rows, based on Column A posted by Patrick Molloy combines B column as comma separated values for rows that have same column A value (merging cells then deleting rows).  (See sumdata.htm for similar things.)
• Combine multiple row groupings into one row per group by Tom Ogilvy "Re: Copy value and paste to multiple cells" - Builddata, from one worksheet combined into another.
• Combine multiple sheets/workbooks into one workbook or into one sheet, Bernie Dietrick, 2001-03-13.
• Fill in the Empty Cells, this macro will fill in empty cells with the content of the cell above it, providing the cell above is also within the selection range.
• See Q89228 -- Excel: AutoFill Rules for Creating a Series
• IncrementStrings by Myrna Larson.  The UDF adds a positive or negative number, N, to the string.  If the character at a given position is an upper case letter, it will remain an upper case letter (i.e. Z wraps to A and generates a "carry"); a lower case letter remains a lower case letter (z wraps to a with a carry); digits remain as digits; symbols are skipped.  Suggested for catalog and invoice numbers.
     Adding 17 to the string AB-0a0 gives AB-0b7
  The maximum value for that "number" would be ZZ-9z9, and the minimum value AA-0a0. A string of ##'s indicates overflow or underflow.
• Insert ROW using a Macro, the macro described will insert row(s) below a selected row or cell.   The advantage of using a macro is that the formulas will be copied, but not the data; providing a more reliable method of inserting lines than simply inserting a row and then dragging a row with formulas and data into an inserted empty row.
• Mail Merge, Using Mail Merge with data from Excel Excel can be used to supply the data to mailmerge in MS Word.  I found this a little tricky first time but have done this from both XL95 and XL2000.  Have included information for printing on labels.  and references such as Zip+4 Lookup System
• Name and Address list reformatting, Tom Ogilvy, 2001-03-31, news:#veqMnfuAHA.1568@tkmsftngp04, Take a three column list, Name, Address(3 rows), phone and convert to Name, Address1, Address2, City3, Phone.  Column A not occupied indicates a continuation.
• Proper, and other Text changes.  PROPER, LOWER (LCase), UPPER (UCase), and TRIM functions.  (VBA functions are in parentheses)
• Reset Last Cell Used  Attempts to provide additional information concerning eliminating unused rows at end and unused columns to right of sheet beyond what can be seen in Q134617.
• Reshape an array of cells.  Alan Beban, his array formulas,  =ArrayReshape(A1:A100,20,5)   Disadvantage compared to other macros is that you have to specify the dimensions.  (also see combine into rows earlier)
• Shortcut keys in Excel Create an Excel Sheet with shortcut keys as a reference that you can find things with the FIND command.
• SnakeCol, Snaking columns is a frequent request on the Excel Newsgroups.   Snaking columns allows you to print several columns on one page.   As the macro currently stands you will have to modify the macro to specify some parameters such as number of rows on a page, how many heading lines, how many columns in the original.
• SUMIF, Primary example uses SUMIF to provide subtotals by date.  Syntax and additional examples are also included.
• Split at first number in a cell (macro), Tom Ogilvy <uIKuAcRZAHA.404@tkmsftngp05>
  Do While Not IsNumeric(Mid(sStr, i, 1))  ...
• Summarizing Data, and Auto Filter, Some examples for Auto Filter (Data menu), Conditional Formatting (Format menu), Pivot Table (Data Menu), Subtotals (Data menu)

Related Information on Other Sites

• Unselecting cells from a selected range: http://www.cpearson.com/excel/unselect.htm
• Working with First and Last Names: http://www.cpearson.com/excel/FirstLast.htm
• Excel to HTML conversions using macros.  XL2HTML-Konverter for XL5/7 in german language -- hwkkonv.zip by Hans W. Herber and also a really simple conversion to HTML without fonts, alignment etc. simple convert (under 30 lines of code).  I used the simple convert for REPT example.  The simple conversion will process a preselected range, use of an InputBox to be able to change the output file.  It will also place &nbsp; when needed for empty cells. 
• Q181148 -- XL97: Using the File Integration Wizard can be use to join worksheets together, haven't used it and the page does not provide examples but it allows you to combine from sources that Excel can read into one sheet and do some arithmetic operations while doing this.

Please send your comments concerning this web page to: David McRitchie mailto:DMcRitchie@msn.com