Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy values from vertically-horizontally
I am a learner at VB and I would like to write a macro for the
following problem. This is an example of a spreadsheet I have with the following column titles: A B C D E F G H I 1 Product Description SUF SFM Bin 2 123254 Whisky 10oz 1 67U0311 3 Pty Bin Qty Stkd Diff 4 1 67U0311 15 5 1 67J1220 13 6 2 67L2329 16 7 Total 34 8 138822 Plate 10cm 1 67K2120 9 Pty Bin Qty Stkd Diff 10 1 67K2120 3 11 2 67K2128 5 12 2 67K2129 8 13 Total 16 Basically it contains the product code, description, SUF (pack size) and SFM Bin (bin assigned). Under that 123254 is the product code and then under that Pty is the priority (takes values from 1 to 2 only) and next to it the alternative bins and the quantity contained next to it. First of all, I need a macro that will get rid of the rows that contain in column A "Pty" and "Total". I don't need this information. I have managed to write a macro for this, which works. Then I need a macro to cut the alternative bin which is in B4 to E2 and the quantity which is C4 to F2. Then again B5 to G2 and C5 to H2 and B6 to I2 and C6 to J2. Then the same again with the next product code. B10 to E8, C10 to F8, B11 to G8, C11 to H8, B12 to I8, C12 to J8. A friend has written the macro for me but it doesn't work quite well. Sometimes the next product gets mixed with the above product. What I want to achieve is bring all the information in one line so that I can sort afterwards to whatever column I want. Therefore, I should have rows like the following: 123254 Whisky 10oz 1 67U0311 67U0311 15 67J1220 13 67L2329 16 138822 Plate 10cm 1 67K2120 67K2120 3 67K2128 5 67K2129 8 The macro that I have which doesn't work 100% is the following: Sub ProcessData() 'Remove rows Dim currentrow As Integer Dim lastrow As Integer currentrow = 1 Sheets("sheet1").Select Range("A65536").Select Selection.End(xlUp).Select lastrow = ActiveCell.Row Do While currentrow <= lastrow Range("A" & currentrow).Select If Trim((ActiveCell.Value)) Like "*Pty*" Or Trim((ActiveCell.Value)) Like "*Total*" Then Rows(currentrow).Select Selection.Delete Shift:=xlUp Else currentrow = currentrow + 1 End If Loop 'Move secondary stock locations to main record Dim pastecolumn As Integer Dim looprow As Integer currentrow = 1 looprow = 1 Sheets("sheet1").Select Range("A65536").Select Selection.End(xlUp).Select lastrow = ActiveCell.Row Do While looprow <= lastrow Range("E" & currentrow).Select If Trim((ActiveCell.Value)) = "" Then pastecolumn = pastecolumn + 2 ActiveCell.Offset(0, -3).Range("A1:B1").Select Selection.Cut ActiveCell.Offset(-1, pastecolumn).Range("A1:B1").Select ActiveSheet.Paste Rows(currentrow).Select Selection.Delete Shift:=xlUp looprow = looprow + 1 Else currentrow = currentrow + 1 pastecolumn = 4 looprow = looprow + 1 End If Loop End Sub Could someone see what the problem is please? Your help will be appreciated! Thanks Vas |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy values from vertically-horizontally
Hi Vas,
Is this simply to continue in the same fashion, each block will contain 3 rows under Pty and 2 columns, that you wish to translate into a block 1 row by 6 columns. If it will continue in this way, and there won't be a block consisting of 4 rows by 2 columns, then here is some code that should work for you (if it is more complicated than this then try to give more details and I will try to work out a solution for you): Change the value of the variable lngTotalBlocks to the number of product blocks that you are processing. I have set it to 2 because that is what is in your example. Perhaps you can work out a value for this based on the last row value, so that this is dynamic. lngOrigFirstRow = the first row of the original data intOrigFirstColumn = the first column of the original data lngNewFirstRow = the first row of the new data intNewFirstColumn = the first column of the original data Sub CopyCells() Const lngTotalBlocks As Long = 2 Dim lngBlockCount As Long Dim intOrigRowCount As Integer Dim intOrigColumnCount As Integer Dim intNewColumnCount As Integer Const lngOrigFirstRow As Long = 4 Const intOrigFirstColumn As Integer = 2 Const lngNewFirstRow As Long = 2 Const intNewFirstColumn As Integer = 5 For lngBlockCount = 1 To lngTotalBlocks intNewColumnCount = 0 For intOrigRowCount = 0 To 2 For intOrigColumnCount = 0 To 1 Cells(((lngBlockCount - 1) * 6) + lngNewFirstRow, intNewColumnCount + intNewFirstColumn) = Cells(((lngBlockCount - 1) * 6) + intOrigRowCount + lngOrigFirstRow, intOrigColumnCount + intOrigFirstColumn) Cells(((lngBlockCount - 1) * 6) + intOrigRowCount + lngOrigFirstRow, intOrigColumnCount + intOrigFirstColumn).Clear intNewColumnCount = intNewColumnCount + 1 Next Next Next End Sub I hope this helps, Sean. -- (please remember to click yes if replies you receive are helpful to you) "vasileib7" wrote: I am a learner at VB and I would like to write a macro for the following problem. This is an example of a spreadsheet I have with the following column titles: A B C D E F G H I 1 Product Description SUF SFM Bin 2 123254 Whisky 10oz 1 67U0311 3 Pty Bin Qty Stkd Diff 4 1 67U0311 15 5 1 67J1220 13 6 2 67L2329 16 7 Total 34 8 138822 Plate 10cm 1 67K2120 9 Pty Bin Qty Stkd Diff 10 1 67K2120 3 11 2 67K2128 5 12 2 67K2129 8 13 Total 16 Basically it contains the product code, description, SUF (pack size) and SFM Bin (bin assigned). Under that 123254 is the product code and then under that Pty is the priority (takes values from 1 to 2 only) and next to it the alternative bins and the quantity contained next to it. First of all, I need a macro that will get rid of the rows that contain in column A "Pty" and "Total". I don't need this information. I have managed to write a macro for this, which works. Then I need a macro to cut the alternative bin which is in B4 to E2 and the quantity which is C4 to F2. Then again B5 to G2 and C5 to H2 and B6 to I2 and C6 to J2. Then the same again with the next product code. B10 to E8, C10 to F8, B11 to G8, C11 to H8, B12 to I8, C12 to J8. A friend has written the macro for me but it doesn't work quite well. Sometimes the next product gets mixed with the above product. What I want to achieve is bring all the information in one line so that I can sort afterwards to whatever column I want. Therefore, I should have rows like the following: 123254 Whisky 10oz 1 67U0311 67U0311 15 67J1220 13 67L2329 16 138822 Plate 10cm 1 67K2120 67K2120 3 67K2128 5 67K2129 8 The macro that I have which doesn't work 100% is the following: Sub ProcessData() 'Remove rows Dim currentrow As Integer Dim lastrow As Integer currentrow = 1 Sheets("sheet1").Select Range("A65536").Select Selection.End(xlUp).Select lastrow = ActiveCell.Row Do While currentrow <= lastrow Range("A" & currentrow).Select If Trim((ActiveCell.Value)) Like "*Pty*" Or Trim((ActiveCell.Value)) Like "*Total*" Then Rows(currentrow).Select Selection.Delete Shift:=xlUp Else currentrow = currentrow + 1 End If Loop 'Move secondary stock locations to main record Dim pastecolumn As Integer Dim looprow As Integer currentrow = 1 looprow = 1 Sheets("sheet1").Select Range("A65536").Select Selection.End(xlUp).Select lastrow = ActiveCell.Row Do While looprow <= lastrow Range("E" & currentrow).Select If Trim((ActiveCell.Value)) = "" Then pastecolumn = pastecolumn + 2 ActiveCell.Offset(0, -3).Range("A1:B1").Select Selection.Cut ActiveCell.Offset(-1, pastecolumn).Range("A1:B1").Select ActiveSheet.Paste Rows(currentrow).Select Selection.Delete Shift:=xlUp looprow = looprow + 1 Else currentrow = currentrow + 1 pastecolumn = 4 looprow = looprow + 1 End If Loop End Sub Could someone see what the problem is please? Your help will be appreciated! Thanks Vas |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Looking up for value vertically and horizontally simultaneously | Excel Worksheet Functions | |||
Can't drag to align shapes vertically or horizontally | Excel Discussion (Misc queries) | |||
How do I freeze panes horizontally and vertically at same time | Excel Discussion (Misc queries) | |||
Move cells vertically to horizontally | Excel Discussion (Misc queries) | |||
Checkbox - Center Horizontally and Vertically | Excel Programming |