Solved

Automatic Transpose By Batch...

Posted on 2000-05-14
18
1,166 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
  • 6
  • 4
  • 4
  • +1
18 Comments
 
LVL 9

Expert Comment

by:antrat
Comment Utility
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
Comment Utility
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
Comment Utility
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
 
LVL 22

Expert Comment

by:ture
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
LVL 9

Expert Comment

by:antrat
Comment Utility
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
Comment Utility
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
Comment Utility
TURE'...Your VB works'..:)
Thanks a lot'..
0
 

Author Comment

by:Silverprex
Comment Utility
Ur VB works'
Thanks a lot'
0
 

Author Comment

by:Silverprex
Comment Utility
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
Comment Utility
Silverprex,

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

/Ture
0
 
LVL 17

Expert Comment

by:calacuccia
Comment Utility
Glad you were helped SilverPrex.

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

Calacuccia
0
 

Author Comment

by:Silverprex
Comment Utility
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
Comment Utility
Anytime :)

antrat
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Suggested Solutions

How many times recently have you prepared a presentation or emailed a document to a client and you have found that they have older versions of MS Office and they can not open the file you have prepared.  Although most visitors to this site are exper…
Introduction It seems that at least a couple of times per month, I answer a question that requires automating Outlook from another Microsoft Office application, usually (although not always) to send one or more email messages.  For example: …
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

771 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now