PDA

View Full Version : Transpose and insert a column to a row on a different sheet



BReilly
07-25-2018, 03:26 PM
I have next to no skill in VBA so i am looking for some help.

I am trying to take a data set on "Sheet 1" organized in a column and insert and transpose the data onto another sheet ("Sheet 2''). I need it to insert new full columns as there will be data associated with the pre-transposed data.

Example:
Sheet 1 Sheet 2
2262422625

I would like the data listed in in column A on "Sheet 1" starting at A11 inserted and transposed on "Sheet 2" in row 8 starting at AJ.

If i insert lines on "Sheet 1" in between values i would like the sheet to have the ability to insert a new column on Sheet2 and transpose the location of the Value.

Please help i feel like it complicated but what do i know.

p45cal
07-26-2018, 10:57 AM
This could be awkward as there'd have to be some way of remembering what had been copied the previous time, then knowing what lines had been inserted. We might be able to mark the rows which have been transposed once, so when we transpose again we only transpose the unmarked rows. It's perfectly possible but…
I'd like to take a step back: In real life I've never come across the need to do this, so could you give us a 'bigger picture' what you're trying to do?
An actual file rather than a picture of one would be useful.

BReilly
07-26-2018, 12:50 PM
A little bit of background behind this is that it will eventually be use to bid on construction work so when we receive a package to review and estimate we receive a price breakdown from the Client we then populate the item number and name, throughout the bidding process the client may add or delete items throughout the bid sheet we then have to add or remove the line where applicable.

If additions are made i would like for the macro to add in the line item as a new column on sheet 2 as not not mix up any of the pre existing data outlined on sheet two which correlates costs back to sheet 1.

p45cal
07-26-2018, 02:52 PM
Q1: Stuff is always (every time) pasted in Sheet2 at cell AJ8 and to the right? (Not in other rows or columns.)
Q2:
we then populate the item number and name, Which columns are those?
Q3: Am I right that the numbers in column A of Sheet1 which remain attached to the same row of data and never actually change their value? So if you inserted a new line on sheet1, you'd have to invent a new number (say 2b, 2c etc.?) for column A? The reason I ask is that I'm hoping to compare the values in Column A of Sheet 1 with the values in cells AJ8 and to the right of sheet 2 to decide where to add/delete columns, but if someone renames any of those cells on either sheet that will fail (those cells can be locked on Sheet2, but not on sheet 1. All I'll do is look at the order of values in Sheet 1 column A and make sure that it's the same in cells AJ8 and to the right, adjusting this by only deleting/adding columns to Sheet2
Q4: When a line is deleted on sheet one, you're happy for the data on Sheet 2 to be deleted irreversibly?
Q5: On sheet 2 data seems to go down to row 195. When you insert a column, do you insert an entire column that would push data in rows 1 to 7 to the right (to the right of the inserted column), or perhaps you only insert cells from row 8 to 195? You tell me.

Again, an actual file rather than a picture of one would be really useful.

BReilly
07-27-2018, 06:29 AM
A1: correct, the numbers in sequential order start from A12 down on Sheet 1 will be transposed on sheet two starting at AJ8 on Sheet 2 no other information is to be transferred from sheet 1 to sheet 2
A2: Columns A and C on sheet one is manually entered based on values received by the client, we are only looking to have the "Item Number" list transposed (A12 down to the grayed out cell on Sheet 1)
A3: The is 100% correct with your statement when we insert new lines on Sheet 1 we give that "Item Number" a value of 1.1,1.2 1.3 etc. all other line numbers will remain the same.
A4: Yes, my only question is, will it be automatic or will we need to press a button to initiate the change?
A5: We are looking for an entire Column to be added on sheet 2, the reason for this is that in some cases the we will require to have more than 195 on sheet 2. (we set the sheet to have 195 rows as a standard but we need to flexibility to change that if required)

p45cal
07-27-2018, 07:03 AM
A4: Yes, my only question is, will it be automatic or will we need to press a button to initiate the change?That's up to you. It would be safer to have a button, so that mis-typing doesn't end up cocking up Sheet2. When the person edits sheet 1, and finally they're happy with it, then click something to update sheet 2.

Again, an actual file rather than a picture of one would be really, really useful.
Without one this project might well go further down my list of priorities.

BReilly
07-27-2018, 07:32 AM
I agree I believe having it linked to a button is best.

The sheet is held at the link let me know if you can access it.

https://1drv.ms/f/s!AhOE4M08YrXigRM78YnhByxmqSZh

p45cal
07-27-2018, 01:09 PM
Test this code in a standard code-module of the file you linked to:
Sub blah2()
With Sheets("Tender Form")

'use this block of code if the first row of data on the "Tender Form" is directly below a cell with just '#' in and it may not always be row 12:
Set tlCell = .Columns(1).Find(what:="#", LookIn:=xlFormulas, lookat:=xlWhole, after:=.Columns(1).Cells(.Columns(1).Cells.Count), searchformat:=False)
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
Set TFRange = .Range(tlCell.Offset(1), .Cells(lr, "A"))


' 'or use this block of code if you're sure data will always start in row 12:
' fr = 12
' lr = .Cells(.Rows.Count, "A").End(xlUp).Row
' Set TFRange = .Range(.Cells(fr, "A"), .Cells(lr, "A"))
' TFRange.Select


TFRange.TextToColumns Destination:=TFRange, DataType:=xlFixedWidth, FieldInfo:=Array(0, 2), TrailingMinusNumbers:=True
'Application.Goto TFRange
myOrder = TFRange.Value
End With 'Sheets("Tender Form")

With Sheets("Equipment")
fc = .Range("AJ8").Column
lc = .Cells(8, .Columns.Count).End(xlToLeft).Column
'If lc < fc Then give up (I've not done anything about this yet)
'convert row 8 to strings:
With Range(.Cells(8, fc), .Cells(8, lc))
'.Select
.NumberFormat = "@"
Set RngToSort = .Resize(500)
' RngToSort.Select
For i = .Cells.Count To 1 Step -1 'Each cll In .Cells
Set cll = .Cells(i)
'cll.Select
cll.Value = CStr(cll.Value)
a = Application.Match(cll.Value, myOrder, 0)
If IsError(a) Then
'cll.Select
cll.Resize(500).Delete Shift:=xlToLeft
End If
Next i
End With '.Range(.Cells(8, fc), Cells(8, lc))

For i = 1 To UBound(myOrder)
a = Application.Match(myOrder(i, 1), .Range(.Range("AJ8"), .Cells(8, .Columns.Count)), 0)
If IsError(a) Then
'RngToSort.Select
'RngToSort.Columns(RngToSort.Columns.Count).Offset(, 1).Select
RngToSort.Columns(RngToSort.Columns.Count).Offset(, 1).Insert Shift:=xlToRight
Set RngToSort = RngToSort.Resize(, RngToSort.Columns.Count + 1)
With RngToSort.Cells(1, RngToSort.Columns.Count)
'.Select
.NumberFormat = "@"
.Value = myOrder(i, 1)
End With 'RngToSort.cells(1, RngToSort.Columns.Count)
'RngToSort.Select
End If
Next i

myCustomOrder = Join(Application.Transpose(myOrder), ",")
With .Sort
.SortFields.Clear
.SortFields.Add Key:=Range("AJ8"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
CVar(myCustomOrder), DataOption:=xlSortNormal
.SetRange RngToSort
.Header = xlNo
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
End With 'Sheets("Equipment")
End Sub
I've gone for not inserting/deleting entire columns, you're in danger of losing data above row 8. Instead I've inserted/deleted cells from row 8, 500 rows deep. If 500 might be too small, you can easily increase it by changing both instances of 500 in the code.
For this to work the transposed data in both sheets (column A in the Tender Form sheet and row headers in the Equipment sheet in row 8 from cell AJ8 to the right) are always converted to text, even if they look like numbers (because I doubt you'll be doing arithmetic with them); you might prefer the way they're sorted if you choose to sort the data in the Tender Form sheet using Excel's sorting.
Up to you to add a button to click to run this code. It means Excel can custom-sort the Equipment sheet, which is what I've used in the code.

BReilly
07-27-2018, 02:56 PM
when I go to the the Macro i am obtaining the following error.
22632

Thanks a lot for your help by the way!

p45cal
07-27-2018, 03:19 PM
It looks like you've updated the file at that link.
You haven't done quite as I asked. You have cleared out all the data from on the Equipment sheet in the vicinity of cell AJ8.
My comment in the code: 'If lc < fc Then give up (I've not done anything about this yet) is pertinent here.
I hadn't considered initialising that sheet, but will look into it… tomorrow.
In the meantime test it on the workbook you previously linked to.

BReilly
07-27-2018, 03:23 PM
i will go back through and try it again.

thanks a lot!

p45cal
07-28-2018, 03:52 PM
Some sticking plaster applied:
Sub blah2()
With Sheets("Tender Form")

'use this block of code if the first row of data on the "Tender Form" is directly below a cell with just '#' in and it may not always be row 12:
Set tlCell = .Columns(1).Find(what:="#", LookIn:=xlFormulas, lookat:=xlWhole, after:=.Columns(1).Cells(.Columns(1).Cells.Count), searchformat:=False)
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
Set TFRange = .Range(tlCell.Offset(1), .Cells(lr, "A"))


' 'or use this block of code if you're sure data will always start in row 12:
' fr = 12
' lr = .Cells(.Rows.Count, "A").End(xlUp).Row
' Set TFRange = .Range(.Cells(fr, "A"), .Cells(lr, "A"))
' TFRange.Select


TFRange.TextToColumns Destination:=TFRange, DataType:=xlFixedWidth, FieldInfo:=Array(0, 2), TrailingMinusNumbers:=True
'Application.Goto TFRange
myOrder = TFRange.Value
End With 'Sheets("Tender Form")

With Sheets("Equipment")
fc = .Range("AJ8").Column
lc = .Cells(8, .Columns.Count).End(xlToLeft).Column
lc = Application.Max(fc, lc)
'If lc < fc Then give up (I've not done anything about this yet)
'cccc = Application.CountA(Range(.Cells(8, fc), .Cells(8, lc)))
'Application.Goto Range(.Cells(8, fc), .Cells(8, lc))
For Each cll In Range(.Cells(8, fc), .Cells(8, lc)).Cells
If Len(Trim(cll.Value)) = 0 Then cll.ClearContents
Next cll
'cccc = Application.CountA(Range(.Cells(8, fc), .Cells(8, lc)))
If Application.CountA(Range(.Cells(8, fc), .Cells(8, lc))) = 0 Then
Range(.Cells(8, fc), .Cells(8, lc)).Cells(1).NumberFormat = "@"
Range(.Cells(8, fc), .Cells(8, lc)).Cells(1).Value = myOrder(1, 1)
End If
With Range(.Cells(8, fc), .Cells(8, lc))
'.Select
.NumberFormat = "@"
Set RngToSort = .Resize(500)
'RngToSort.Select
'convert row 8 to strings:
For i = .Cells.Count To 1 Step -1 'Each cll In .Cells
Set cll = .Cells(i)
'cll.Select
cll.Value = CStr(cll.Value)
a = Application.Match(cll.Value, myOrder, 0)
If IsError(a) Then
'cll.Select
cll.Resize(500).Delete Shift:=xlToLeft
End If
Next i
End With '.Range(.Cells(8, fc), Cells(8, lc))

For i = 1 To UBound(myOrder)
a = Application.Match(myOrder(i, 1), .Range(.Range("AJ8"), .Cells(8, .Columns.Count)), 0)
If IsError(a) Then
'RngToSort.Select
'RngToSort.Columns(RngToSort.Columns.Count).Offset(, 1).Select
RngToSort.Columns(RngToSort.Columns.Count).Offset(, 1).Insert Shift:=xlToRight
Set RngToSort = RngToSort.Resize(, RngToSort.Columns.Count + 1)
With RngToSort.Cells(1, RngToSort.Columns.Count)
'.Select
.NumberFormat = "@"
.Value = myOrder(i, 1)
End With 'RngToSort.cells(1, RngToSort.Columns.Count)
'RngToSort.Select
End If
Next i

myCustomOrder = Join(Application.Transpose(myOrder), ",")
With .Sort
.SortFields.Clear
.SortFields.Add Key:=Range("AJ8"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
CVar(myCustomOrder), DataOption:=xlSortNormal
.SetRange RngToSort
.Header = xlNo
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
End With 'Sheets("Equipment")
End Sub

BReilly
07-30-2018, 05:02 AM
The macro works Flawlessly! thanks a lot!

now that this is working i was wondering if you could look at adding a few additional features.

i have attached a updated copy with some comments.
https://1drv.ms/f/s!AhOE4M08YrXigRM78YnhByxmqSZh

you will see there is a second table that lies below the first on the "Equipment" sheet this will be used to calculate the month cost of a piece of equipment based on a manual percentage entered in the first table. Also if possible instead of having the "Items" transpose starting at AJ8 to have it complete after a symbol this way we can add columns before AJ8 and the macro will still work. when you look at the updated sheet it will be easy to see i think.

Thanks again for your help!

p45cal
07-30-2018, 07:37 AM
I think I've applied another tweak to deal with looking for a # symbol on row 8, but it should be the only # symbol on the row, and by itself in the cell. If it's not there it will do nothing. I haven't tested it. It will delete the totals column.
Regarding the heading in the second, lower table, it's best to put formulae as you did with one of them. As long as the rearrangement of columns includes that second table (currently it does due to the 500 in the code) it should be fine.

Sub blah2()
With Sheets("Tender Form")

'use this block of code if the first row of data on the "Tender Form" is directly below a cell with just '#' in and it may not always be row 12:
Set tlCell = .Columns(1).Find(what:="#", LookIn:=xlFormulas, lookat:=xlWhole, after:=.Columns(1).Cells(.Columns(1).Cells.Count), searchformat:=False)
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
Set TFRange = .Range(tlCell.Offset(1), .Cells(lr, "A"))


' 'or use this block of code if you're sure data will always start in row 12:
' fr = 12
' lr = .Cells(.Rows.Count, "A").End(xlUp).Row
' Set TFRange = .Range(.Cells(fr, "A"), .Cells(lr, "A"))
' TFRange.Select


TFRange.TextToColumns Destination:=TFRange, DataType:=xlFixedWidth, FieldInfo:=Array(0, 2), TrailingMinusNumbers:=True
'Application.Goto TFRange
myOrder = TFRange.Value
End With 'Sheets("Tender Form")

With Sheets("Equipment")
Set tlc = .Rows(8).Find(what:="#", LookIn:=xlFormulas, lookat:=xlWhole, after:=.Cells(8, .Columns.Count))
If Not tlc Is Nothing Then
Set tlc = tlc.Offset(, 1)
fc = tlc.Column
lc = .Cells(8, .Columns.Count).End(xlToLeft).Column
lc = Application.Max(fc, lc)
'If lc < fc Then give up (I've not done anything about this yet)
'cccc = Application.CountA(Range(.Cells(8, fc), .Cells(8, lc)))
'Application.Goto Range(.Cells(8, fc), .Cells(8, lc))
For Each cll In Range(.Cells(8, fc), .Cells(8, lc)).Cells
If Len(Trim(cll.Value)) = 0 Then cll.ClearContents
Next cll
'cccc = Application.CountA(Range(.Cells(8, fc), .Cells(8, lc)))
If Application.CountA(Range(.Cells(8, fc), .Cells(8, lc))) = 0 Then
Range(.Cells(8, fc), .Cells(8, lc)).Cells(1).NumberFormat = "@"
Range(.Cells(8, fc), .Cells(8, lc)).Cells(1).Value = myOrder(1, 1)
End If
With Range(.Cells(8, fc), .Cells(8, lc))
'.Select
.NumberFormat = "@"
Set RngToSort = .Resize(500)
'RngToSort.Select
'convert row 8 to strings:
For i = .Cells.Count To 1 Step -1 'Each cll In .Cells
Set cll = .Cells(i)
'cll.Select
cll.Value = CStr(cll.Value)
a = Application.Match(cll.Value, myOrder, 0)
If IsError(a) Then
'cll.Select
cll.Resize(500).Delete Shift:=xlToLeft
End If
Next i
End With '.Range(.Cells(8, fc), Cells(8, lc))

For i = 1 To UBound(myOrder)
a = Application.Match(myOrder(i, 1), .Range(tlc, .Cells(8, .Columns.Count)), 0)
If IsError(a) Then
'RngToSort.Select
'RngToSort.Columns(RngToSort.Columns.Count).Offset(, 1).Select
RngToSort.Columns(RngToSort.Columns.Count).Offset(, 1).Insert Shift:=xlToRight
Set RngToSort = RngToSort.Resize(, RngToSort.Columns.Count + 1)
With RngToSort.Cells(1, RngToSort.Columns.Count)
'.Select
.NumberFormat = "@"
.Value = myOrder(i, 1)
End With 'RngToSort.cells(1, RngToSort.Columns.Count)
'RngToSort.Select
End If
Next i

myCustomOrder = Join(Application.Transpose(myOrder), ",")
With .Sort
.SortFields.Clear
.SortFields.Add Key:=tlc, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
CVar(myCustomOrder), DataOption:=xlSortNormal
.SetRange RngToSort
.Header = xlNo
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
End If
End With 'Sheets("Equipment")
End Sub
As for the rest, the addition of a Totals column and the generation of the second table, this is called 'milking it'.
I've done more than I'm usually prepared to do for nothing, especially as this is obviously a commercial project.
You may have some luck if you post a new thread (although I doubt it).

BReilly
07-30-2018, 08:12 AM
This is great, thank you very much!!!