PDA

View Full Version : Shifting data in cell from a work book to another based on some condition.



strider
06-12-2009, 04:52 AM
Hi :hi:

I have a data in an excel sheet which i need to copy it to another excel file ( either by creating the new excel file dynamically / to already created excel file) based on conditions as mentioned below.

Pls find the sample.xls attached with.

Which has Source sheet in which shows the actual format of the data. and another sheet called Final output which shows the final format for which i need a program.

As u can see there are 10 types like (Type1, Type2......., Type10) and each type has some products like Type1 has product T101 and Type2 has T201, T202, T203.
i.e., no of products various with each Type and Details is same for all the product in particular Type like Type2 has 3 products with same details.

Now i need a program which puts a type in one line as in the Final output sheet.

i.e., Final out format will be like this,

Type | Product1 | Product2 | Product3 | Product4 | Details

This is the header in this case a type cane have only 4 products not more then that. so if Type1 has only one product then the productID of that product should be put below Product1, if it has 2 products its should fill Product1 and Product2 and others will be blank. and detail with respect to type.

and this should happen a click on button.

Pls refer the file attached for correct picture of what i was explaining.

can u ppls help me in solving this problem.:friends:

GTO
06-15-2009, 03:46 AM
Greetings

Firstly, I notice that this is your first post and that you joined this month. Welcome to vbax , in my opinion, the 'coolest' forum around. I can tell you that you'll 'meet' some of the nicest folks, who will go out of their way to help one learn a 'better way' and provide a solution.

Now as to your project, while there is no code in your attachment, the before/after seemed clear, so hopefully this will give you one way of basically transposing the data to a new workbook.

In a Standard Module:

Option Explicit

Sub FlipData()
Dim _
wbDest As Workbook, _
wksDest As Worksheet, _
wksSource As Worksheet, _
rngSourceBCol As Range, _
rngTemp As Range, _
rngCell As Range, _
rngDest As Range, _
i As Long, _
lBottomResize As Long, _
lLoopIncrease As Long, _
lOffset As Long, _
aryText() As String, _
aryTranspose As Variant

'// Set a reference to a new, one-sheet workbook and arbitrarily save it as //
'// "MyData.xls" to the same folder as ThisWorkbook resides in. Change to suit... //
Set wbDest = Workbooks.Add(xlWorksheet)
Application.DisplayAlerts = False
wbDest.SaveAs (ThisWorkbook.Path & "\MyData.xls")
Application.DisplayAlerts = True

'// Since the new wb has only one sheet, set a reference to it, rename the sheet //
'// and toss the first couple of values in the header row. //
Set wksDest = wbDest.Worksheets(1)
wksDest.Name = "Destination"
wksDest.Range("A1:B1").Value = Array(" sl ", " Type ")

'// Set a reference to our source sheet... //
Set wksSource = ThisWorkbook.Worksheets("Source")
'// ...as well as the range we need to look at. //
Set rngSourceBCol = _
wksSource.Range("B2:B" & wksSource.Cells(Rows.Count, 2).End(xlUp).Row)

'// Seed our array w/one empty element. //
ReDim aryText(1 To 1)

'// This requires that the 'Types' are kept together, as it only 'looks' downward //
For i = 1 To rngSourceBCol.Rows.Count

lBottomResize = 1
lLoopIncrease = 0

'// Initially set both these to cell B2, then they will be reset to the proper //
'// cell ea loop. //
Set rngCell = wksSource.Range("B" & 1 + i)
Set rngTemp = rngCell

'// Now since we do not yet know what the max number of product IDs for a Type,//
'// we'll need to store ea 'Type's' detail string in a array, and plant it in //
'// the correct column later. /
aryText(UBound(aryText)) = rngCell.Offset(, 2).Value
ReDim Preserve aryText(1 To UBound(aryText) + 1)

'// Since rngCell will be the first cell for a given 'Type', we'll loop and //
'// resize rngTemp as long as the next cell down matches. //
Do While rngCell.Value = rngCell.Offset(lBottomResize).Value

Set rngTemp = wksSource.Range(rngCell, rngCell.Offset(lBottomResize))
lOffset = IIf(rngTemp.Rows.Count > lOffset, rngTemp.Rows.Count, lOffset)
lLoopIncrease = rngTemp.Rows.Count - 1
lBottomResize = lBottomResize + 1
Loop

i = i + lLoopIncrease

'// After building ea rngTemp, we'll grab the cells next to it for the 'Product //
'// IDs', and stick these values in a transposed array. //
aryTranspose = Application.WorksheetFunction.Transpose(rngTemp.Offset(, 1).Value)
'// Set a reference to the firts available cell in B Col of the Dest sheet. //
Set rngDest = wksDest.Cells(Rows.Count, 2).End(xlUp).Offset(1)
'// Bring the values to the new sheet, excepting the Detail //
rngDest.Offset(, -1).Value = rngDest.Row - 1
rngDest.Value = rngCell.Value
rngDest.Offset(, 1).Resize(, rngTemp.Rows.Count).Value = aryTranspose
Next

ReDim Preserve aryText(1 To UBound(aryText) - 1)

'// Now since we're done transporting data, we know the max number of product IDs //
'// and can put the detail strings in the correct column. //
Set rngDest = wksDest.Range("B2:B" & wksDest.Cells(Rows.Count, 2).End(xlUp).Row)
rngDest.Offset(, lOffset + 1).Value = Application.WorksheetFunction.Transpose(aryText)

'// Finally, we can also complete our header row... //
Set rngDest = wksDest.Range(wksDest.Cells(1, 3), wksDest.Cells(1, 2 + lOffset))

i = 0
For Each rngCell In rngDest
i = i + 1
rngCell.Value = " Product ID " & i & Chr(32)
Next

rngDest(1, i).Offset(, 1).Value = "Details"

With rngDest.Offset(, -2).Resize(1, rngDest.Columns.Count + 1 + 2)
.Font.Bold = True
.EntireColumn.AutoFit
End With

wbDest.Save
End Sub


Hope that helps,

Mark

strider
06-15-2009, 05:55 AM
Thanks Mark:sparkle:

yes im new to this forum and excel programming too.....:yes

one more question if i want to run this code by clicking a command button. i.e., i want to add a button in the source sheet when we click on the button output should be generated.:dunno

Regards,
Theertha

GTO
06-15-2009, 01:18 PM
Hi Therta,

There are a couple of different types of controls, those from the Forms toolbar and the kind that go on userforms (dialog boxes) that are referred to as activex controls. You an read some of the particulars in Help by by querying "add buttons to a worksheet" or similar.

To add a command button from the Forms toolbar, right-click in the menu/toolbars area and select Forms. Then click on the command button and left-click and drag on the sheet to set the size of the button.

When you release the mouse button, the Assign Macro dialog will pop-up. Simply select the 'FlipData' macro (should be the only macro showing) and press the <OK> button.

Hope that helps,

Mark

strider
06-15-2009, 10:54 PM
Thank u very much Mark:sparkle:

I got it......:bow:

GTO
06-15-2009, 11:38 PM
Thank u very much Mark:sparkle:

I got it......:bow:

Happy to help :thumb and glad that worked.

If solved, there's a Mark Solved button under Thread Tools right above your first post. This marks the thread as solved so others don't continue to check the thread.

Thanks and have a great day :-)

Mark