Solved: help on tranposing data from column

Hi,

I needed some help here concerning transposing. Till now this code has been doing a great job for me and has been very helpful :

here is the code am using actually for transposing from row to column.


[vba]Sub Transposing_modules_defined_on_planner()
Dim x As Long

Dim lastrow As Long


Application.ScreenUpdating = False
Application.EnableEvents = False

Sheets("PLANNER").Select
Range("D4:D65536").ClearContents
lastrow = Range("G65536").End(xlUp).Row

For x = 4 To lastrow

Range("G" & x & ":IV" & x).Copy

Range("D63536").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Next x


Range("D4").Select

Application.CutCopyMode = False
Application.ScreenUpdating = True


Application.EnableEvents = True
End Sub[/vba]




This transposes all the loaded and define modules of the order to a column which we have already duplicated.

Just for info this is only part of the data I am giving for an idea normally this consist of more than 2000 rows.

Normally after having duplicated the orders as per the column E ( see order 1000 on attachement) I will run the code which will transpose all the modules loaded according to each order to column D which is the modules.

I just want to know if there is a possibility to transfer now the modules from the column to rows where we initially defined the modules that is on the first of each order not on the duplicate orders because many times we changes the modules on the column D when doing the planning on another file and need to have it back again for next week plan.

i have attached a sample data for example.

Many thanks for the help in advance.

HI can someone please assist me on that many thanks.

Hi

i have been searching some of helps and have come across this code
[VBA]Public Sub ProcessData() Dim i As Long Dim LastRow As Long With Application .ScreenUpdating = False .Calculation = xlCalculationManual .DisplayAlerts = False End With With ActiveSheet LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row For i = LastRow + (25 - LastRow Mod 25) To 24 Step -25 .Cells(i - 24, "A").Resize(25).Copy .Cells(i - 24, "B").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Transpose:=True .Rows(i - 23).Resize(24).Delete Next i .Columns(1).Delete End With With Application .DisplayAlerts = True .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub [/VBA]


this has been propose By XLD before to someone who needed almost the same help.

I have been trying to modified it as this one is transfering data every 25 rows i think but have not been able to make it work on my problem.

As in my file the data from the column D shall be transpose to to first order where the module has been defined starting from column G. that is if there is order where module is not defined on column G then it shall skip and move to next.

Many thanks again for helping.

Hi

i have been searching some of helps and have come across this code
[VBA]Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow + (25 - LastRow Mod 25) To 24 Step -25

.Cells(i - 24, "D").Resize(25).Copy
.Cells(i - 24, "G").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Transpose:=True
'.Rows(i - 23).Resize(24).Delete
Next i
.Columns(1).Delete
End With

With Application

.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub[/VBA]




this has been propose By XLD before to someone who needed almost the same help.

I have been trying to modified it as this one is transfering data every 25 rows i think but have not been able to make it work on my problem.

As in my file the data from the column D shall be transpose to to first order where the module has been defined starting from column G. that is if there is order where module is not defined on column G then it shall skip and move to next.

Many thanks again for helping.

Hi ,

I have been able to do it through some useful tips from the net .Here is code which i have been able to work out and its working till now.
[vba]Sub PLANNER_TRANSPOSE_ROWS()

Dim LR As Long, i As Long, j As Long, k As Long

Application.ScreenUpdating = False
'Customer_ROW = Range("Customer_ROW").Row + 1

LR = Range("A" & Rows.Count).End(xlUp).Row

j = 1 'ROWS STARTING TO READ DATA
k = 7 ' COLUMN TO START TRANSPOSING OF DATA

For i = LR To 2 Step -1
If Range("F" & i).Value <> "" Then Rows(i).Insert 'CONTROL COLUMN TO KEEP VALUE WHEN MODULE WAS DEFINED TO LOAD
Next i

LR = Range("D" & Rows.Count).End(xlUp).Row ' READ MODULE IN COLUMN

For i = 1 To LR
With Range("D" & i)
If .Value = "" Then
j = j + 1
k = 7
Else
k = k + 1
Cells(j, k).Value = .Value
End If
End With
Next i
Call cut_modules
For i = LR To 2 Step -1
If Range("F" & i).Value = "" Then Rows(i).Delete 'CONTROL COLUMN TO KEEP VALUE WHEN MODULE WAS DEFINED TO LOAD
Next i
Call place_modules
'Columns("F").SpecialCells(xlCellTypeBlanks).Delete
'Columns("D").Delete
'Columns("A:H").AutoFit
Application.ScreenUpdating = True
End Sub
Sub cut_modules()

'use to keep all the transpose data on a seperate sheets as blank rows will be deleted on the main data.

Application.ScreenUpdating = False

Sheets("DATA_MAIN").Select
Columns("H:W").Select
Selection.Copy
Sheets("Sheet3").Select
Columns("B:B").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("H9").Select
Sheets("DATA_MAIN").Select
Application.ScreenUpdating = True
End Sub
Sub place_modules()

' this part replace the transpose module after deletion of the blank rows.
Application.ScreenUpdating = False

Sheets("Sheet3").Select
Columns("B:V").Select
Selection.Copy
Sheets("DATA_MAIN").Select
Columns("H:H").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("H1").Select
Application.ScreenUpdating = True
End Sub[/vba]

if someone can just give some tips more on how to make it more easier it will be of great help.

May be this can be of help to some other friends here.

many thanks again.