Solved

Automatic Transpose By Batch...

Posted on 2000-05-14
18
1,287 Views
Last Modified: 2008-02-26
Is there an automatic way of doing the "transpose " by batch in Excel..?
I have thousands of records in the excel sheet having this kind of format:

record1           record3
company           company
address           address
phone             phone

record2           record4
company           company
address           address
phone             phone

I want to put it this way in a single excel sheet :
field1      field2     field3     field4
record1     company    address    phone
record2     company    address    phone
record3     company    address    phone
record4     company    address    phone

Im doing it manually..Copy the 1st record then "Paste Special" then check the "Transpose"

I there a batch transpose'..? or formula on this ..Thanks'
0
Comment
Question by:Silverprex
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 4
  • 4
  • +1
18 Comments
 
LVL 9

Expert Comment

by:antrat
ID: 2809451
Hi Silverprex

You would have to use a macro do do this automatically, like the one below.

You will probaly need to change "Sheet1" and "Sheet2" to your sheet names. You will also need to make sure there is something in Cell A1 on Sheet2.

How it works:

1: Sets the variables Copysht and Pastesht to become Sheet1 and sheet2.

2: Counts how many times the word "Record*" appears on Sheet1. The "*" is a wildcard character.

3: Searches Sheet1 and Finds "Record1". Copies it and the 3 cells below (Company,Address,Phone).Then Tranposes them onto The first non blank cell on Sheet2 in Column A.

4:Does the same as above (point 3) accept this time with "Record2"
and keeps doing this as many times as the word "Record*" appears on Sheet1.
**************************************

To put the macro in and run it.

1:Hit Alt+F11 and then go to Insert>Module and paste in the code below.

2:Hit Alt+Q to get back to the worksheet. Now save

3:Go to Tools>Macro>Macros and select "Transpose" then click run.
***************************************


Sub Transpose()
Dim i As Long
Dim CopySht As Worksheet
Dim Pastesht As Worksheet
On Error Resume Next

Set CopySht = Sheets("Sheet1")
Set Pastesht = Sheets("Sheet2")

'do as many times as there are records.
For i = 1 To _
WorksheetFunction.CountIf(CopySht.UsedRange, "Record*")

'Copy each "Record?" and the 3 cells below
CopySht.UsedRange.Find("Record" & i).Range("A1:A4").Copy

'transpose them in last blank cell in column A _
on Sheet2
Pastesht.Columns("A:A").Find(What:="*", _
  After:=[A1], Searchdirection:=xlPrevious).Offset _
  (1, 0).PasteSpecial Transpose:=True
       
 Next i
End Sub


antrat

0
 
LVL 17

Expert Comment

by:calacuccia
ID: 2809556
Hi Silverprex,

Antrats macro will only work if you have litterally named your records 'Record1', 'Record2',...

If that is not the case, is there any other way to find out a pattern, are they spread in a logical way over the sheet, or just at random ? The difficulty here will be to find the records on your original sheet, not the paste special.

Calacuccia
0
 
LVL 22

Expert Comment

by:ture
ID: 2809670
Silverplex,

How, exactly, are your original records arranged?

Are they in column A and B, with the first record in cell A1, each record being exactly 5 cells high?

If so, I'll post a non-VBA solution for you shortly...

/Ture
0
MS Dynamics Made Instantly Simpler

Make Your Microsoft Dynamics Investment Count  & Drastically Decrease Training Time by Providing Intuitive Step-By-Step WalkThru Tutorials.

 
LVL 22

Expert Comment

by:ture
ID: 2809741
Silverplex,

If your data is on Sheet1 and arranged as I wrote in my previous post, this formula will help you. Enter the formula in cell A1 on Sheet2:

  =INDEX(Sheet1!$A:$A,ROW()*5-(5-COLUMN()))&""

Copy the formula from A1 into A1:E1 and then copy the range A1:E1 as far as needed. This will give you all records from Column A on Sheet1.

Use Sheet3 to exctract all records from column B. Enter this formula in cell A1 and copy in the same way as the previous formula.

  =INDEX(Sheet1!$B:$B,ROW()*5-(5-COLUMN()))&""

When you have used these formulas to transpose all records, copy the lists from Sheet2 and Sheet3 and Paste Special/Values into a final destination sheet.

Ture Magnusson
Karlstad, Sweden
0
 

Author Comment

by:Silverprex
ID: 2810407
Antrat I did not litereally mean record1 as record1 .
Ture

My records are in column A and B . No big deal if the 1st record located in Cell a1 or A2 or A3 right..? Last NO , not exactly 5 cells high ..There might be 6 and there r 4 cells high. Wht separates each record is a single or double row field..U think anyone of you knows how to code a Macro on that ..? (That if the records reaches a blank field it then go to the next field for transpose')
0
 
LVL 17

Expert Comment

by:calacuccia
ID: 2810970
Hi SilverPrex,

Use this macro to put your data on  new sheet, called 'Transposed Records'.

It supposes you launch the macro from the active sheet, by using Alt+F8, select Macro 'TransposeIt' and click the 'Run' button.

Here it is:
Sub TransposeIt()
Dim i As Long
Dim r As Long
Dim os, ns
Set os = ActiveSheet
ActiveWorkbook.Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Transposed Records"
Set ns = ActiveSheet
For i = 1 To 6
    ns.Cells(1, i) = "Field" & i
Next i
r = 2
i = 1
If os.Cells(i, 1) = "" Then i = os.Cells(i, 1).End(xlDown).Row
While i < os.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
ni = os.Cells(i, 1).End(xlDown).Row
os.Range(os.Cells(i, 1), os.Cells(i, 1).End(xlDown)).Copy
ns.Cells(r, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
r = r + 1
i = os.Cells(ni, 1).End(xlDown).Row
Wend
i = 1
If os.Cells(i, 2) = "" Then i = os.Cells(i, 2).End(xlDown).Row
While i < os.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
ni = os.Cells(i, 2).End(xlDown).Row
os.Range(os.Cells(i, 2), os.Cells(i, 2).End(xlDown)).Copy
ns.Cells(r, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
r = r + 1
i = os.Cells(ni, 1).End(xlDown).Row
Wend
End Sub

Hope this helps
Calacuccia

0
 
LVL 17

Expert Comment

by:calacuccia
ID: 2810993
The same macro again, with some formatting and comments, for better readability.

Sub TransposeIt()

'Declaration of variables
Dim i As Long, ni As Long
Dim r As Long
Dim os, ns

'Declare the ActiveShet to os
Set os = ActiveSheet

'Create new sheet (Transposed Records)
ActiveWorkbook.Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Transposed Records"
Set ns = ActiveSheet

'Fill first row of new sheet with Field1 to Field6
For i = 1 To 6
    ns.Cells(1, i) = "Field" & i
Next i

'Initial value for variable r, counting the actual row number on new sheet
r = 2
'Reset i to 1 (just a row counter)
i = 1
'Look for first row in column A with data
If os.Cells(i, 1) = "" Then i = os.Cells(i, 1).End(xlDown).Row

'The loop for column A
While i < os.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
    'ni is just an intermediate variable
    ni = os.Cells(i, 1).End(xlDown).Row
    'Copy the record just found
    os.Range(os.Cells(i, 1), os.Cells(i, 1).End(xlDown)).Copy
    'Paste it into new sheet, transposed, on new row
    ns.Cells(r, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
    'Add one to the paste row number
    r = r + 1
    'Find next line in column A with data
    i = os.Cells(ni, 1).End(xlDown).Row
Wend

'Reset counter to 1 for loop in B column
i = 1
'Once again, look for first non-empty cell in column B
If os.Cells(i, 2) = "" Then i = os.Cells(i, 2).End(xlDown).Row

'Loop for column B, exactly the same as for column A
While i < os.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
    ni = os.Cells(i, 2).End(xlDown).Row
    os.Range(os.Cells(i, 2), os.Cells(i, 2).End(xlDown)).Copy
    ns.Cells(r, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
    r = r + 1
    i = os.Cells(ni, 1).End(xlDown).Row
    Wend
End Sub

Calacuccia
0
 

Author Comment

by:Silverprex
ID: 2813175
Calacc'
I select all the records from column a then Run the Macro but then I got this error' :
"The information cannot be pasted because the copy are and the paste are are not the same size and shape. Try one of the following
* Click a single cell and then paste
* select a rectangle that's the same size and shape, and then paste "

0
 
LVL 22

Accepted Solution

by:
ture earned 50 total points
ID: 2813421
Silverplex,

Here is my VBA procedure...

Sub Transp()
  'Declare variables
  Dim SourceWs As Worksheet
  Dim DestWs As Worksheet
  Dim Sourcerange As Range
  Dim SourceColumn As Range
  Dim SourceCell As Range
  Dim DestCell As Range
 
  'Set variables
  Set SourceWs = Worksheets("Sheet1")
  Set DestWs = Worksheets("Sheet2")
  Set Sourcerange = Intersect(SourceWs.UsedRange, SourceWs.Range("A:B"))
  Set DestCell = DestWs.Cells(1, 1)
 
  'Loop through each column in the range
  For Each SourceColumn In Sourcerange.Columns
    'Loop through each cell in the column
    For Each SourceCell In SourceColumn.Cells
      'If source cell is empty, then move destination cell to
      'the beginning of the next row, unless destination cell
      'is in the first column
      If IsEmpty(SourceCell) Then
        If DestCell.Column > 1 Then
          Set DestCell = DestWs.Cells(DestCell.Row + 1, 1)
        End If
      'If source cell has a value, write it to destination cell
      'and move destination cell one step to the right
      Else
        DestCell.Value = SourceCell.Value
        Set DestCell = DestCell.Offset(0, 1)
      End If
    Next SourceCell
   
    'Move destination cell to the beginning of the next row
    'unless destination cell is in the first column
    If DestCell.Column > 1 Then
      Set DestCell = DestWs.Cells(DestCell.Row + 1, 1)
    End If
  Next SourceColumn
End Sub

/Ture
0
 
LVL 9

Expert Comment

by:antrat
ID: 2813549
Hi Silverplex

Hows this one? It adds a sheet called "transposed" to transpose your data onto. It also inserts a column so that column B becomes Column C and then puts it back, this is so the CurrentRegion method will work properly.

Sub TransposeRecords()
Dim ToSheet As Worksheet
Dim FromSheet As Worksheet
Dim i As Long, ii As Long
Application.ScreenUpdating = False
'Add a sheet and set variables
Set FromSheet = ActiveSheet
Sheets.Add
ActiveSheet.Name = "Transposed"
Set ToSheet = ActiveSheet

'put a blank column between.
FromSheet.Columns("B:B").Insert
'Set ii to become the first row # with data
ii = FromSheet.Columns("A:A").End(xlDown).Row

'Do as many times as there are areas _
in column A
For i = 1 To FromSheet.Columns _
("A:A").SpecialCells(xlCellTypeConstants, 23).Areas.Count
FromSheet.Cells(ii, 1).CurrentRegion.Copy
ToSheet.Cells(i, 1).PasteSpecial Transpose:=True
ii = FromSheet.Cells(ii, 1).CurrentRegion.End _
(xlDown).End(xlDown).Row
Next

'ReSet ii to become the first row # with data _
in what was column B
ii = FromSheet.Columns("C:C").End(xlDown).Row
'Do as many times as there are areas _
in column C (which was B)
For i = 1 To FromSheet.Columns _
("C:C").SpecialCells(xlCellTypeConstants, 23).Areas.Count
FromSheet.Cells(ii, 3).CurrentRegion.Copy
ToSheet.Columns("A:A").End(xlDown).Offset _
(1, 0).PasteSpecial Transpose:=True
ii = FromSheet.Cells(ii, 3).CurrentRegion.End _
(xlDown).End(xlDown).Row
Next

'delete the extra column so _
column C becomes B again
FromSheet.Columns("B:B").Delete
Application.ScreenUpdating = True
End Sub


Just yell if you need more.

antrat

0
 
LVL 9

Expert Comment

by:antrat
ID: 2813559
This may be easier to read.

Sub TransposeRecords()
Dim ToSheet As Worksheet
Dim FromSheet As Worksheet
Dim i As Long, ii As Long
Application.ScreenUpdating = False

'Add a sheet and set variables
Set FromSheet = ActiveSheet
    Sheets.Add
    ActiveSheet.Name = "Transposed"
Set ToSheet = ActiveSheet

'put a blank column between.
FromSheet.Columns("B:B").Insert

 'Set ii to become the first row # with data
 ii = FromSheet.Columns("A:A").End(xlDown).Row

'Do as many times as there are areas _
in column A
For i = 1 To FromSheet.Columns _
 ("A:A").SpecialCells(xlCellTypeConstants, 23).Areas.Count
  FromSheet.Cells(ii, 1).CurrentRegion.Copy
   ToSheet.Cells(i, 1).PasteSpecial Transpose:=True
   ii = FromSheet.Cells(ii, 1).CurrentRegion.End _
    (xlDown).End(xlDown).Row
Next

'ReSet ii to become the first row # with data _
in what was column B
ii = FromSheet.Columns("C:C").End(xlDown).Row

'Do as many times as there are areas _
in column C (which was B)
For i = 1 To FromSheet.Columns _
 ("C:C").SpecialCells(xlCellTypeConstants, 23).Areas.Count
  FromSheet.Cells(ii, 3).CurrentRegion.Copy
  ToSheet.Columns("A:A").End(xlDown).Offset _
   (1, 0).PasteSpecial Transpose:=True
    ii = FromSheet.Cells(ii, 3).CurrentRegion.End _
    (xlDown).End(xlDown).Row
Next

 'delete the extra column so _
 column C becomes B again
 FromSheet.Columns("B:B").Delete
Application.ScreenUpdating = True
End Sub


antrat
0
 

Author Comment

by:Silverprex
ID: 2813656
TURE'...Your VB works'..:)
Thanks a lot'..
0
 

Author Comment

by:Silverprex
ID: 2813661
Ur VB works'
Thanks a lot'
0
 

Author Comment

by:Silverprex
ID: 2813682
Antrat ur last solution works too'..but then was able to use first Ture's VB'.
Guys..thanks a lot'!!
0
 
LVL 22

Expert Comment

by:ture
ID: 2813694
Silverprex,

I'm glad that I could help you. Thanks for the points!

/Ture
0
 
LVL 17

Expert Comment

by:calacuccia
ID: 2813727
Glad you were helped SilverPrex.

The weird thing is that my macro runned perfectly in my testing ?

Calacuccia
0
 

Author Comment

by:Silverprex
ID: 2813830
Antrat ur last solution works too'..but then was able to use first Ture's VB'.
Guys..thanks a lot'!!
0
 
LVL 9

Expert Comment

by:antrat
ID: 2815312
Anytime :)

antrat
0

Featured Post

Office 365 Training for IT Pros

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft Office Picture Manager was included in Office 2003, 2007, and 2010, but not in Office 2013. Users had hopes that it would be in Office 2016/Office 365, but it is not. Fortunately, the same zero-cost technique that works to install it with …
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This video walks the viewer through the process of creating envelopes and labels, with multiple names and addresses. Navigate to the “Start Mail Merge” button in the Mailings tab: Follow the step-by-step process until asked to find the address doc…
Learn how to make your own table of contents in Microsoft Word using paragraph styles and the automatic table of contents tool. We'll be using the paragraph styles in Word’s Home toolbar to help you create a table of contents. Type out your initial …

710 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question