VB and VBA Users Source Code: Transpose the contents of an Excel Range
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Transpose the contents of an Excel Range
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, April 02, 2001
Hits:
769
Category:
Unspecified
Article:
The following routine transposes the contents of an Excel Range (i.e. Swaps the rows and columns over). Option Explicit 'Purpose : Transpose the contents of a range 'Inputs : rngTranspose The range to transpose (i.e. swap the rows an columns) ' bClearOriginal If True deletes the contents of the original range. 'Outputs : Returns True on success 'Author : Andrew Baker 'Date : 31/12/2000 13:51 'Notes : 'Revisions : Function RangeTranspose(rngTranspose As Excel.Range, Optional bClearOriginal As Boolean) As Boolean Dim rngIntersect As Excel.Range, rngThisCell As Excel.Range On Error GoTo ErrFailed If rngTranspose.Columns.Count * rngTranspose.Rows.Count > 1 Then rngTranspose.Parent.Range(rngTranspose.Cells(1), rngTranspose.Cells(rngTranspose.Columns.Count, rngTranspose.Rows.Count)).Value = WorksheetFunction.Transpose(rngTranspose.Value) If bClearOriginal = True Then 'Delete the original range Set rngIntersect = Application.Intersect(rngTranspose, rngTranspose.Parent.Range(rngTranspose.Cells(1), rngTranspose.Cells(rngTranspose.Columns.Count, rngTranspose.Rows.Count))) For Each rngThisCell In rngTranspose If Application.Intersect(rngThisCell, rngIntersect) Is Nothing Then rngThisCell.Clear End If Next End If End If RangeTranspose = True Exit Function ErrFailed: RangeTranspose = False On Error GoTo 0 End Function 'Demonstration routine. 'Select a number of cells in a worksheet and run this routine Sub Test() RangeTranspose Selection, True End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
