Many of the macros here are useful for reformatting name and address listings, and others for creating test data. This document describes macros for
This page contains some VBA macros. If you need assistance to install or to use a macro please refer to Getting Started with Macros. For more depth see Install a Macro or User Defined Function on my Formula page.
Speed and efficiency considerations can be seen in Proper, and other Text changes and in Slow Response.
The above macros do not actually destroy data, and can be reversed out (subject to some restrictions).
- Join()
- Joins selected columns on a row by row basis and includes a space between each cell concatenated. Reverse of SepTerm().
- JoinRows()
- Joins Rows within a column within a single area selection. Vertical equivalent of JOIN().
- 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() and FixCANADAzips
- Fixup for 5 digit zip codes that have been stripped of first zero or show as a number.
FixCANDAzips restores missing space in Canadian zip codes.- Firstname()
- Put firstname before lastname, for cells with "Lastname, Firstnames".
- Fix_PhoneAreaCode()
- Fixup to add default area code to 7 digit local area code phone numbers.
- Debug Format
- Use of Worksheet Functions to determine the actual data content: ISNUMBER, ISTEXT, LEN, ISBLANK, CODE, GetFormula, GetFormat
- 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).
- ReEnterSuff_F()
- Append a suffix to a value or formula to make a formula
- RemoveAllSpaces
- Remove all spaces and Char(160). variation: RemoveAllSpaces2() leaves row 1 intact.
- ReversI()
- Reverses the items in a selection so that the first becomes the last, and the last becomes the first.
- 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.
- 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 SepTerm(). Also available on the code\join.txt page are SepLastName for people's names, SepLastWord uses StrReverse new in Excel 2000, LastWord function uses StrReverse, resubstr function using VBA Script.
- TrimALL()
- Trims all cells in a selection
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.
Related macros on other pages of mine (also see Related
- FillSequence()
- Creates test data by sequential numbers into selected range(s). i.e. 1,2,3,4,5,6,7,8,etc.
- 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.
- 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
- MarkSeq, code for Sub MarkSeq( )
- Creates test data with sequential numbers and allow inclusion of a prefix and/or a suffix
- Random003, code for Sub Random003( )
- Creates random 3 digit numbers
- RandomAZ, code for Sub RandomAZ( )
- Creates random single letters A-Z
- Fill Empty
- includes manual steps, and macro solutions to fill in empty cells below descriptive headers, so a table column can be sorted. Some additional topics on this page, some are brief descriptions pointing to another page
- DebugFormat
- Some tips for determining what kind of data you actually have in a cell, is it a number or is it text, and why is it seen that way.
- 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).
Have tried to limit the scope of Join() and SepTerm() by checking for the lastcell. Without some kind of a limitation the macro subroutines would take a very long time cycling through 16384 rows in XL95, or 65536 rows in XL97 and later. The limitation can be corrected better (come back in a year). All of the macros can work with a selection involving multiple rows and columns. In SepTerm selection of a single or multiple columns is the same. The cells to the right of the first column will be verified as empty or containing only spaces.
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 1998-08-05 [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 SubJOINROWS, join content of cells vertically within selection (#joinrows)
Code not shown is included with code for other macros described on this page. See Samples below for an example of usage.
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
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. See Samples below for an example of usage.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 SubWorksheet 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)
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 do not begin with two zeros, but a medication has been made for someone using 3 digit numbers for other countries and the Caribbean. 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)See the code for a macro (fixCANADAzips) to fix Canadian zip codes codes where the required space was omitted.
Sub FixUSzip5() 'David McRitchie 2000-04-28 notposted, updated 2001-12-14 'http://www.mvps.org/dmcritchie/excel/join.htm#fixUSzip5 Application.ScreenUpdating = False Application.Calculation = xlManual Dim cell As Range Dim cValue Dim cPos As Long 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 SubWorksheet solutions for US zip codes
Formatting numbers in zip code format: (Format, Cells, custom), will still be numbers and text (suggest left justifying)
[<100000]00000_-_0_0_0_0;[>0]00000-0000;;@Make everything text for 5-digit and zip+4 all will be text (sortable as text «)
=TEXT(F2,"[<100000]00000_-_0_0_0_0;[>0]00000-0000;;@")Make everything 5 character zip codes with leading zeros - strip last 4 digits of 9-digit zip codes (sortable as text)
=LEFT(TEXT(F2,"[<100000]00000;[>0]00000-0000;;@"),5)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
Sorting on the first 3 digits may be the minimum requirement for a particular class of mail. 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))
As US phone area code apply to smaller and smaller areas, and even moving into overlapping Area Codes, fixing up phone lists to include area code is becoming a very frequent event. The following will convert phone numbers such as 555-1212 as text or formatted number to text (xxx) 555-1212.Since area codes are now required in most of the US even for local calls the preferred format will probably be xxx-555-1212 without parens, modify code below if that seems preferable.
Sub Fix_PhoneAreaCode() Dim cell As Range On Error Resume Next 'in case nothing found Dim AreaCode As String AreaCode = "412" AreaCode = InputBox("Supply your local area code " & _ "to be prefixed to phone numbers without an area code" _ & Chr(10) & " i.e. " & AreaCode _ & " will prefix current entries with ""(" & _ AreaCode & ") """, "Supply Area Code", AreaCode) If AreaCode = "" Then Exit Sub AreaCode = "(" & AreaCode & ") " For Each cell In Intersect(Selection, _ Selection.SpecialCells(xlConstants, xlTextValues)) If Len(cell) = 8 Then 'as in 555-1212 cell.Value = AreaCode & Trim(cell.Value) End If Next cell 'On Error Resume Next -- continues in effect For Each cell In Intersect(Selection, _ Selection.SpecialCells(xlConstants, xlNumbers)) If cell > 999999 And cell < 9999999 Then cell.Value = AreaCode & Format(cell.Value, "000-0000") End If Next cell End Sub
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 1998-07-30 documented in ' http://www.mvps.org/dmcritchie/excel/join.htm 'Reverse (Flip) Item values in Range, Row, or Column [Ctrl+R] 'Counting in multiple rows/cols, item count proceeds down a 'column in range and continues top of next column in range Dim tcells As Long, mCells As Long, ix As Long, ox As Long Dim iValue As Variant 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
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 rowsNote: 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 Long Dim nRows As Long Dim nCols As Long 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
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 1998-08-05 [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 SubConsiderations in working with data from HTML sources
The macro above does not include replacing a non breaking space character ( ) 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:=FalseA 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 if only interested in the street, to remove the number at the beginning, if present, before the first space, use. [Rag Dyer 2005-04-23]=IF(ISERR(--LEFT(A1,FIND(" ",A1))),"",LEFT(A1,FIND(" ",A1)-1)) -- number if present =IF(ISERR(--LEFT(A1,FIND(" ",A1))),A1,MID(A1,FIND(" ",A1)+1,100)) -- street nameor 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
Finding out what you actually have -- it may not be what it looks like (#debugformat)Formatting: Check what the cell was formatted for with Format, cells and look at the format. Changing the format between Text and Number will have no effect on data already entered, but reentry of data will be changed if valid.
Changing the number format for a cell that is a number, shows true for =ISNUMBER(C2), will be immediately effective when the format is changed.
Finding out how Excel is recognizing your data« is the first step, you can use worksheet functions individually, but you might want to check a lot of cells at one time. Start with selecting a group of cells such as columns D:F to find out if they are blank, numbers, or text. Only cells within the used range will be identified.
Each of the following will change your selection so you will have to start over from:
Select cells, Ctrl+G (Edit, GoTo), [Special] button {and then use one of the following:
to find blanks (empty cells), [x] blanks
to find text cells, [x] constants, [x] text
to find numbers cells, [x] constants, [x] numbersSome worksheet formulas to help show what you actually have:
=IF(ISTEXT(E2),"T",IF(ISNUMBER(E2),"N","L"))&LEN(E2)
=ISNUMBER(E2)
=ISTEXT(E2)
=LEN(E2)
=ISBLANK(E2) [in VBA the equivalent is ISEMPTY]
=CODE(E2) =CODE(RIGHT(E2,1))
=personal.xls!GetFormula(E2)
=personal.xls!GetFormat(E2)
="'*" & D6 & "*" & CODE(RIGHT(D6,1))Cell View, http://www.cpearson.com/excel/CellView.htm (40KB installed), Chip Pearson, addin shows the Ascii Code for each character in a cell, which be easier than invoking CODE Worksheet Function for each character yourself (ASC in VBA). The most common problems would be finding 010 for line-break and not having cell-wrap format option turned on, finding 013 for Carriage-Return which is ignored in Excel, or finding 160 for the non-breaking space character ( ) introduced by pasting HTML into Excel (see TrimALL macro below.
The CODE Worksheet Function determines the ASCII code for a single character. The TRIM Worksheet Function will remove code 32 space from left and right sides. But a macro such as TRIMALL can simply the TRIM by doing it in place and by converting the HTML (non-breaking space) character 160 to spaces before trimming.
The formula or text 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.
Cell F9 is formatted as a number before entry; the rest in the column are formatted as text before entry.
  F G H I J K L M 6 Text Number Add Sum Formula in Add Column Formula in SUM Column ISNUMBER for Column F ISNUMBER for col G 7 1 2 3 2 =F7+G7 =SUM(F7,G7) FALSE TRUE 8 2 2 4 2 =F8+G8 =SUM(F8,G8) FALSE TRUE 9 3 2 5 5 =F9+G9 =SUM(F9,G9) TRUE TRUE 10 4 2 6 2 =F10+G10 =SUM(F10,G10) FALSE TRUE 11 XX 2 #VALUE! 2 =F11+G11 =SUM(F11:G11) FALSE TRUE 12 XX xx #VALUE! 0 =F12+G12 =SUM(F12:G12) FALSE FALSE
When you change the format between text and numbers (could be either under General) the actual format does not change until the content is reentered. Changes between numeric formats are immediate. You can check how Excel sees the data with =ISTEXT(A1) -- see debugformat. You could have some non-breaking spaces in a formula -- see TrimALL macro.Reenter using Worksheet solutions after changing the format, one of the following should work.
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.
- F2 then Enter (even though this is one at a time this is good to see if this is the problem)
- Change "=" to "=" using Ctrl+H (good to activate formulas, also make sure Calulation is set to Automatic)
- Select an empty cell, copy with Ctrl+C, select the cells to be reentered such as a column, Edit, Paste Special, Add
- use a macro such as one of the following:
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 SubApparently need to use F2 to reenter an email address so back to an updated version that really doesn't make any difference whether screen updating is turned off or not.Sub ReEnterF2() ' successfully will reenter email addresses Dim cell As Range, rng As Range, rng2 Dim tcells As Long, ix As Long Set rng = Intersect(Selection, ActiveSheet.UsedRange) Set rng2 = Selection If rng Is Nothing Then Exit Sub Application.ScreenUpdating = False Application.Calculation = xlCalculationAutomatic tcells = rng.Count For ix = 1 To tcells rng.Item(ix).Formula = Trim(rng.Item(ix).Formula) rng.Item(ix).Activate SendKeys "{F2} {enter}" Next ix rng2.Select Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Suband the opposite, to make formulas into text. Also see GetFormula() on my Formula page.Tested for single and multiple cell selections with/without formulas Tested for single and multiple cell selections in a sheet without any formulas
Following a posting by Ron de Bruin it appears I could have done this without a loop so I will show that version first.
Sub ReEnterAsValues() 'D.McRitchie 2002-12-04 Misc. -- no loops, preferred solution Dim Rng As Range On Error GoTo done Set Rng = Intersect(Selection, Selection.SpecialCells(xlFormulas)) If Rng Is Nothing Then Exit Sub On Error GoTo 0 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'pre XL97 xlManual Dim cell As Range Intersect(Selection, Selection.SpecialCells(xlFormulas)).Value = _ Intersect(Selection, Selection.SpecialCells(xlFormulas)).Value Application.Calculation = xlCalculationAutomatic 'pre XL97 xlAutomatic Application.ScreenUpdating = True done: End Sub Sub ReEnterAsValues() 'D.McRitchie 2002-12-04 Misc. Dim Rng As Range On Error GoTo done Set Rng = Intersect(Selection, Selection.SpecialCells(xlFormulas)) If Rng Is Nothing Then Exit Sub On Error GoTo 0 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'pre XL97 xlManual Dim cell As Range For Each cell In Rng cell.Value = cell.Value 'to get text values instead use ="'" & cell.value Next cell Application.Calculation = xlCalculationAutomatic 'pre XL97 xlAutomatic Application.ScreenUpdating = True done: End SubTo 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 [ISEMPTY in VBA or ISBLANK in Excel] cells from being processed. CHR(160) is the non breaking space character ( ) 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.The use of the CLEAN Worksheet Function to remove unprintable characters will only remove CHAR(0) through CHAR(31), Char(129), Char(141), Char(143), and Char(144). It will have no effect on Char(160). The use of CLEAN removes the character, you might very well have preferred a space or other character. If you are not getting the results you want reread an earlier topic: Finding out what you actually have -- it may not be what it looks like.
To manually remove Char(160) manually see Keying in a Non-breaking space CHAR(160). Also known as non-breaking space character ( ) and Required Blank (RBL).
The TrimALL macro will remove excess spaces, but be sure that is what you want. Removing and converting characters may make record unsuitable to a database that is used to having certain characters as filler, which in some cases could include doubled spaces.
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. Chip Pearson's “Cell View” addin makes viewing code within a cell easier than repeated use of CODE(cell).
Instructions to install and use a macro at the top of this page actually refer you to another page — Gettting started with macros.
The code for TrimALL and other macros on this page is at – http://www.mvps.org/dmcritche/excel/code/join.txt
While most of the code is represented below, the actual code contains additional substitutions relating to grabbing tables from HTML to eliminate CR(13), CRLF(13,10), BS(08), TAB(09).Sub TrimALL() 'David McRitchie 2000-07-03 mod 2000-08-16 2005-09-29 join.htm '-- http://www.mvps.org/dmcritchie/excel/join.htm#trimall ' - Optionally reenable improperly terminated Change Event macros Application.DisplayAlerts = True Application.EnableEvents = True 'should be part of Change Event macro If Application.Calculation = xlCalculationManual Then MsgBox "Calculation was OFF will be turned ON upon completion" End If 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 On Error Resume Next 'in case no text cells in selection For Each cell In Intersect(Selection, _ Selection.SpecialCells(xlConstants, xlTextValues)) cell.Value = Application.Trim(cell.Value) Next cell On Error GoTo 0 Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End SubMost of the need for the TRIMALL macro arises from copying and pasting from an HTML web page. Another problem run into from copy and pasting HTML material is unwanted shapes (pictures, buttons, icons) that were copied along with the text. See shapes.htm for page concerning shapes including macros for deleting all shapes (delShapesOnSht), and selectively deleting shapes (delShapesSel) from a worksheet.The following uses code and suggestions from Dave Peterson I believe is almost equivalent in results to the above and runs in about 1/2 the time as the above for selections involving a large number of cells to actually be changed. There is one difference the above is shown with the Excel TRIM, if it used the VBA TRIM they would be closer. Wouldn't make much difference to me except when CHAR(160) is next to a space, I would want to make sure I end up with only a single space. For that reason I probably will continue to prefer the version above. Though if one had sentences it wouldn't be good to eliminate the extra space after periods. Neither version will affect formulas. It always comes down to knowing your data and your tools and exactly what you want.
Sub TRIMALL_alternate() 'Dave Peterson, programming, 2002-08-17 'http://google.com/groups?as_umsgid=3D5EEE8D.601CB075@msn.com Dim myRange As Range Dim myCol As Range Set myRange = Intersect(ActiveSheet.UsedRange, Selection) If myRange Is Nothing Then Exit Sub Application.ScreenUpdating = False myRange.Replace What:=Chr(160), Replacement:=Chr(32), _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False For Each myCol In myRange.Columns If Application.CountA(myCol) > 0 Then myCol.TextToColumns Destination:=myCol(1), _ DataType:=xlFixedWidth, FieldInfo:=Array(0, 1) End If Next myCol Application.ScreenUpdating = True End SubThe following code will Remove all Spaces from the selected area. Compare to TrimAll above (at beginning of this topic).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 SubVariation to leave row 1 intactSub RemoveAllSpaces2() 'David McRitchie 2002-08-27 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 SubCode to convert Text dates in a column to Dates can be found on DateTime pageThe ASAP Utilities [Download ASAP Utilities], includes over 300 utilities including the option to trim spaces.
You can use Chip Pearson's Cell View to view the characters and their corresponding decimal or hexidecimal codes. This should be sufficient for most usage but Unicode values not in your font will show with a dec code of 063 or a hex code of 3F.
An interesting problem use of SUMIF for a check register for SUM of all items in with same category as in column F. public.excel, 2005-10-12)
I147: =SUMIF($F$1:$F$361,TRIM(F147),$G$1:$G$361)
Actually you could probably simply use this form, even if G148 had a total would work as long as there is a unique description in column F for that row. =SUMIF(F:F,TRIM(F147),G:G)The macros that follow would only be needed if you have someone prone to placing spaces in a cell that don't belong there. Spaces do not clear out a cell.
The following is an Change Event macro and is installed by right clicking on the sheet tab then inserting the code.
Private Sub Worksheet_Change(ByVal Target As Range) 'This will convert 0003 to a number 3 If Target.Column <> 6 Then Exit Sub 'col 6 is "F" On Error GoTo ErrHandler Application.EnableEvents = False If Target.Column = 6 Then If Not Target.HasFormula Then Target.Value = Trim(Target.Value) End If End If ErrHandler: Application.EnableEvents = True End Sub
Replace formulas with values in a selection.Sub Convert_to_Values_in_Selection() '-- david (unknown), 2005-07-31 programming '-- http://google.com/groups?threadm=FA9A30E6-FB39-4B24-A0FA-DE9BCF8FAED4%40microsoft.com Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False ActiveSheet.Paste Application.CutCopyMode = False End Sub
Replace formatted numeric values to the text values in a selection. Expect to see this to be use to eliminate custom phone number formatting, and other custom formatting where numbers were used insead of text. With international phone numbers a custom number format just does not help. Would probably work well on zipcodes as well but I have a macro for fixUSzip5 earlier on this page.Sub Convert_Numeric_Constants_to_Text_in_Selection() 'convert cells with numeric constants to text ' leave it up to to format right if wanted ' or run TrimALL macro if wanted Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim cell As Range For Each cell In _ Selection.SpecialCells(xlCellTypeConstants, 1) cell.Value = cell.Text Next cell Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End SubAlso have a Convert_to_Text_in_Selection that covers numbers that were as constants or as formulas. See code/join.txt
This is a macro solution that will convert in place. for a worksheet solution see sorting.htm#mixed.Sub Convert_Numeric_Constants_to_Text_in_Selection() 'convert cells with numeric constants to text ' leave it up to to format right if wanted ' or run TrimALL macro if wanted Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim cell As Range On Error Resume Next 'no cells found in selection For Each cell In _ Selection.SpecialCells(xlCellTypeConstants, 1) cell.Value = cell.Text Next cell Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub
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 formulaSub 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
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 specific notes for data preparation immediately after the macro code below. See Samples below for an example of usage. See Considerations for HTML non-breaking-space ( ) Suggested shortcut key [Ctrl+t]
Sub SepLastTerm() 'David McRitchie 1998-08-20 [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 lastnames: You will probably have to rework your results afterwards, but you might save some trouble if you have a lot of prefixed last names by changing such names containing "Mac ", "van " and "von " to "Mac_", "van_" and "von_" beforehand and then removing the unscore later. Not a problem for anything I've writtern here but also be aware of names like O'Connor. Watch out for changes to capitalization and to exceptions -- it always comes down to you have to know your data, but such steps may save you some time. In the coding to go with this page are some additional subroutines and functions mainly related to lastnames or separating the last word. SepLastName for people's names, SepLastWord uses StrReverse new in Excel 2000, LastWord function uses StrReverse. Another concept is an example of a VBA Script function, resubstr.join by Harlan Grove which is interesting but has too many assumptions on data fitness for my use.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) Additional zipcode information may be found with MailMerge documentation but most of fixing and separating zip codes will continue to be found here on this page. Briefly Mail Merge can accept data from the first worksheet tab in your Excel file as the data (database) and use it to create name and address labels, and/or to create letters. Columns must have headings for Mail Merge to function. Start blank (new) word document, Tools --> Mail Merge --> labels etc. See FixUSzip5 on this page for additional information.
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, but you can take some steps to save time later by first combining some prefixes or combinations into one word such as changing "New " to "New_" as in "New York" to "New_York", and "Washington D.C." to "Washington_D.C." > ahead of time doing the separation and then removing the underscores later.
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 like the previous example this is an array formula Ctrl+Shift+Enter so that you see braces on the formula line surrounding entire formula. (possible errors #VALUE! if not entered as an array formula, or #N/A! if there are not at least two words)
=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.
This is about the worst case, without any commas for separation and no distinction separation between street, and town.200 Flinders St Melbourne VIC 3000wanted as[Ctrl+t]
  A B C D E 1 200 Flinders St Melbourne VIC 3000 Sub SplitAddressing() '-- include St Ave Ct Cir Blvd etc. as needed Columns("A:A").Replace What:=" St ", _ Replacement:=" St,", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False Columns("A:A").Replace What:=" Ave ", _ Replacement:=" Ave,", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False Columns("A:A").Replace What:=" Ct ", _ Replacement:=" Ct,", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False '-- if you had US states that you don't want to separate Columns("A:A").Replace What:=" New York ", _ Replacement:=" New_York", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False Columns("A:A").TextToColumns DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1)) Columns("B:B").Insert Shift:=xlToRight Columns("A:A").Select SepTerm Columns("C:C").Select SepLastTerm Columns("d:d").Insert Shift:=xlToRight Columns("C:C").Select SepLastTerm Columns("A:E").EntireColumn.AutoFit End SubAlso see posting 2002-04-18 by Myrna Larson.
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)))
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, 1999-02-04 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 repeats text a given number of times, in the example below spaces are repeated. Use of REPT was suggested by Thomas Ogilvy (1998-08-05) 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 referred 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.
A | B | =GetFormula(B1) |
---|---|---|
102 Wash. Blvd. | 102 Wash. Blvd. | =REPT(" ",6-SEARCH(" ",TRIM(A1)))&TRIM(A1) |
1024 Wash. Blvd. | 1024 Wash. Blvd. | =REPT(" ",6-SEARCH(" ",TRIM(A2)))&TRIM(A2) |
1027 Wash. Blvd. | 1027 Wash. Blvd. | =REPT(" ",6-SEARCH(" ",TRIM(A3)))&TRIM(A3) |
00026 Wash. Blvd. | 00026 Wash. Blvd. | =REPT(" ",6-SEARCH(" ",TRIM(A4)))&TRIM(A4) |
The VAL function extracts leading digits ignoring embedded spaces.
Function NumVal(n) As Double NumVal = VAL(n) 'obtains leading number value ' -- Dana DeLouis 2000-11-29 End Function
123abc678 Result --> 123A112 Result --> 0 12 a 67 b 12 Result --> 12 12 45 Result --> 1245 Extract numbers from a cell
The number must be contiguous. Non-contiguous characters in the ten characters examined result in #Value! error.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*Note that it is an array formula and should be entered with Ctrl+Shift & Enter
A short demonstration of items on this page can be accomplished by installing each of the macros on this page -- Join(), ReversI(), SepTerm(), MarkCells(), and MarkSepAreas(). Each of these macros are frequently used in testing.MarkCells() will destroy previous contents within Selection 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 1998-08-17 [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 SubThe following is a little shorter and eliminates a Dim statement in the old code now commented out.
A single quote inside double quotes is included in both examples. In Excel 97 and above the For Each version will handle multiple selected areas.For Each Cell In Selection Cell.Value = "'" & Cell.AddressLocal(0, 0) Next CellThe Worksheet Function equivalent is =ADDRESS(ROW(),COLUMN(),4) but the value will change when it is moved to match the cell it is in. The use of MarkCells is to show where the cell was originally after moving things around, not where it currently resides after moving things around. You can place 'A1 into cell A1 and fill down to be more like the macro MarkCells, and when you move things around it will show where it used to be just like you would see if you had used the macro.
Mark Separate Areas (MarkSepAreas) is similar to MarkCells but has been enhanced to process separate areas. Processing of separate areas is based on a posting by Alan Beban that was actually filling out an array, I thought a minor modification might make for a more interesting version of MarkCells() above.Sub MarkSepAreas() 'David McRitchie 1999-06-03 Mark cells with cell address and 'area number. Enhanced based on Alan Beban code 1999-06-03. '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 SubNote the areas are the areas in the order in which they were added to the selection. Alan's original code would produce an array which I believe might be something conceptually like:
$F$2, $G$3, $H$4:$I$4, $I$5, $H$5, $H$7, $I$7, $H$9:$I$9
F2-1 G3-2 H4-3 I4-3 H5-5 I5-4 H7-6 I7-7 H9-8 I9-8 Usually you make a single selection of multiple cells by left-clicking on a cell and dragging without releasing the button to make your selection. The range is a rectangular area. The Ctrl key is use if you want to add additional selection areas. For worksheet things (no macros) it won't make any difference how many separate (rectangular) areas you created when do things like assign a color, or format.
With a macro you can process each area separately and until Excel 2000 that is what you had to do. Excel 2000 allows you process all selections as if they were one or as in MarkSepAareas you can still process each area in the same manner as had to be done in previous versions.
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 the order it was selected and filled in before continuing to the next range.Worksheet Equivalent as formulas
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 SubColors depict
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
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
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.
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 SubCompare 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 |
Use of MarkCells
|
Use of ReversI
|
Use of Join on Original
|
Use of SepTerm
|
before JOINROWS()
|
after JOINROWS()
|
Use of Lastname()
|
|
Name and Address List before SepLastTerm
| Name and Address List after SepLastTerm on Col C
|
RotateCW() Before
|
RotateCW() After Rows flipped
| RotateCW() After TRANSPOSE
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Formatting and Formulas are preserved |
Good Luck! Happy EXCELing.
Splitting on Space:
With all the emphasis here on macros don't forget Data-->Text to columns, and especially keep in mind that there is a both a delimited and a fixed option. The fixed option will allow you to split a single word in each row into multiple cells on each row.Splitting on a single comma:
It is possible to eliminate the extra space after the comma strictly with Text to Columns. Personally I would use my TrimALL macro since I have it set up.Data, Text to Columns, comma delimiter
to separate into the two columns (dependent on there being only one comma in the cell)Data, Text to Columns, fixed width
double click or drag the break line off the window to remove, then with only one column use the Finish button.Thank goodness for backups the remainder of this document starting from within the next topic was discovered missing 2004-11-08 and recovered from a backup from 2004-08-27. — — — —
The following example will generate a multiplication table starting at cell A1.
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 SubB2: =$A2*B$1
  A B C D E 1 1 2 3 4 2 1 1 2 3 4 3 2 2 4 6 8 4 3 3 6 9 12 5 4 4 8 12 16 6 5 5 10 15 20 A1: =ROW( )*COLUMN( )
  A B C D E F G 1 1 2 3 4 5 6 7 2 2 4 6 8 10 12 14 3 3 6 9 12 15 18 21 4 4 8 12 16 20 24 28 5 5 10 15 20 25 30 35 6 6 12 18 24 30 36 42
and then use the fill handleThe following example will generate an addition table starting at the currently active cell.
Another approach to generate your Multiplication Table and Addition Table is to use the fill handle with formulas.
Sub AdditionTab() noCols = InputBox("Number of columns") noRows = InputBox("Number of Rows") Dim noCOls as Long, noRows as Long Dim 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 SubWorksheet Solution:
  A B C D E F G H I 1 0 1 2 3 4 5 6 7 8 2 1 2 3 4 5 6 7 8 9 3 2 3 4 5 6 7 8 9 10 4 3 4 5 6 7 8 9 10 11 5 4 5 6 7 8 9 10 11 12 6 5 6 7 8 9 10 11 12 13 7 6 7 8 9 10 11 12 13 14
A1: =Row( )-1 + Column( )-1
and then use the fill handle
Multiplication Table starting in cell A1: =(Row()-1)*(Column()-1)
Addition Table starting in cell A1: =Row()-1+Column()-1
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
Smith iii Smith iii Smith iii Smith iii Smith, Smith Smith, John A. John A. Smith Smith,, , Smith Smith,, John A. , John A. Smith Smith,,O B ,O B Smith Smith,J. Jones J. Jones Smith Smith,J. Jones J. Jones Smith Smith,J. Jones,DDS,Dr J. Jones,DDS,Dr Smith Smith,O O Smith Smith,O O Smith Smith,O B O B Smith 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. (both different approaches from what I've shown on this page)
=AFTLAST(E22) Function AFTLAST(cell As Range, findchar As String) As String Application.Calculation = xlCalculationManual 'in XL97 Dim i as Long 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
Remove everything to left of first "/"=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.
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
The complete thread AN=590672177 includes an XL95 version with changes to Calculation, SpecialCells, and Replace.
DCK-43V--- FS--4824--G3--- SWS---7224--SThis macro will remove doubled hyphens as well as prefixed and suffixed hyphens for TEXT value within a selected range. Will ignore numbers like -7. TRIM which removes spaces will be performed on all text cells that contain at least one hyphen within the selected area. 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 SubEnclose_Text_cells is a similar macro which can be found in code/join.txt to enclose all text cells in a selection within left and right parenentheses (open and close parens) doing both a prefix and a suffix of cells. (#enclose_text_cells)
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 Subinsertprefix 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 SubSQUOTE_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 (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 Long 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
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
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
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 Long, j As Long 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
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").ColumnFind 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.columnFind 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 NumberFinding the Relative Address of a cell.
Assumes you have A1 addressing: Tools --> Options --> General --> with R1C1 offPlace 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 SubWorksheet 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)**
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.
Dates used in text usually relate to posting dates in Google Advanced Usenet Search for microsoft.public.excel* newsgroups.
Sorting, sorting data
String Manipulations
Please send your comments concerning this web page to: David McRitchie send email comments
Copyright © 1997 - 2006, F. David McRitchie, All Rights Reserved