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 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.
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.
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()
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
65536").ClearContents
Reply With Quote