PDA

View Full Version : [SOLVED] Transponse help



markecb
01-15-2016, 12:47 AM
Can I speed up this process, not a problem for a couple of people, but if there is 150+ any help is welcome

As you can see in the pictures to get a result on the sheet 2 had to:

1. copy from sheet 1 paste special into new sheet (marked Transpose option)
2. select all cell with data and make degrees to 0
3. double center cells, modify cell to bold, font size etc...
4.repeat all for second person etc etc..

Is there any VBA or Macro to have this prosses automatically as I write data from one sheet to get a result on the sheet 2

Here is dropbox with an example workbook link...

https://www.dropbox.com/s/ka2qvilazc...test.xlsx?dl=0 (https://www.dropbox.com/s/ka2qvilazcgdgg8/current-test.xlsx?dl=0)

mancubus
01-15-2016, 01:40 AM
you can post your workbook here.

Go Advanced
Manage Attachments
Add Files
Select Files
Open
Upload Files
Done

markecb
01-15-2016, 05:53 AM
Files for Transpose help

mancubus
01-15-2016, 07:12 AM
thanks snb for getting me into the habit of using index function with arrays.



that said, below will handle 1st and 4th steps.

2nd and 3rd not clear to me.
since they are about formatting, record a macro while manually formatting the cells in Columns A and B of sheet List2. then post your recorded macro here so we can insert/adopt it to below code.

try this code with a copy of your file.



Sub vbax_54847_Create_Separate_Tables_Each_Row_Transposed()
'http://www.vbaexpress.com/forum/showthread.php?54847-Transponse-help

Dim j As Long, k As Long
Dim pList

With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With

Worksheets("List1").Copy After:=Worksheets(Worksheets.Count)

With ActiveSheet
.Rows(1).Delete
.UsedRange.Rows(1).SpecialCells(xlCellTypeBlanks) = Chr(10)
pList = Application.Transpose(.Cells(1).CurrentRegion.Value)
.Delete
End With

k = 1
With Worksheets("List2")
.Cells.Clear 'clear existing data
For j = 2 To UBound(pList, 2)
.Cells(1, k).Resize(UBound(pList)).Value = Application.Index(pList, , 1)
.Cells(1, k + 1).Resize(UBound(pList)).Value = Application.Index(pList, , j)
k = k + 3
Next
End With
End Sub


PS: a table's top left cell must be A1 and first column (generally record id's) and first row (headers or field names) must contain no blank cells. below line inserts a non printinting character into blank cells in the header row. i chose Chr 10.


.UsedRange.Rows(1).SpecialCells(xlCellTypeBlanks) = Chr(10)

markecb
01-15-2016, 02:30 PM
Thank you Mancubus
--------------------------------
2nd and 3rd not clear to me.
since they are about formatting, record a macro while manually formatting the cells in Columns A and B of sheet List2. then post your recorded macro here so we can insert/adopt it to below code.
_________________________

Here is a YouTube link that basically explains what I'm doing (https://youtu.be/BVX7PVmHPYs)

markecb
01-16-2016, 02:01 PM
With slight modifications code works what I needed and for details using Format Painter.

Thank you.

SamT
01-16-2016, 04:22 PM
Problem Solved? Use Thread Tools above the thread to mark it.