how to copy data (some of them) and copy in an other sheet)

[Blanqui]

Hello,

i'm not completly a beginner but i would need help on the following project:


Sheet1:

A B C D E F G
1 Bill Paul
2 Product $amount Product $amount
3
4
5

on sheet 2 the data are stored:

A B C D E F G
Deal num brand Quantity Product price end money salesmen
1 001245 Aegon 1 XX 100 100 Bill
2 001456 Dal 2 XY 75 150 Paul
3 014586 Sall 1 XZ 1000 1000 Bill
4Etc......
5



I would like to find a way to copy only the product name end the end money from the sheet 2 to the sheet 1and under the good salesmen:


A B C D E F G
1 Bill Paul
2 Product $amount Product $amount
3 XX 100 XY 150
4 XZ 1000
5 etc...

i tried to start doing some IF functions,..... not very successfull

Can someone please help me to code this.

thank you very much.

[Blanqui]

just realized that the layout of my email is all messed up.

To sum up the data are located in sheet 2
the columns are: deal num ,brand ,Quantity , Product, price ,end money , salesmen.

i would like to create a macro to copy in sheet 1 just the product and the end money.


the logic would be if in sheet 2, line 1 column "salesman" is "bill" then copy product and end money in sheet 1.
then go to the next line.

thanks again for your help

[GTO]

Hi there,

Might I suggest knocking up a sample wb and attaching it?

Mark

PS - In .xls format!

[Blanqui]

Hi Mark,

here is the file attached.

thank you

[GTO]

Hi Blanqui,

As I am not sure if I am on the right track, there are no 'safety's' inlcuded, but see if this is close.

In a Standard Module:
Option Explicit

Public Sub exa()
Dim DIC As Object '<--- Dictionary
Dim wks As Worksheet
Dim rngData As Range
Dim Cell As Range
Dim rngStart As Range
Dim aryKeys As Variant
Dim dKeys As Variant
Dim dItems As Variant
Dim aryJaggedOutput() As Variant
Dim lRecord As Long
Dim i As Long

'// Set a reference to an instance of a dictionary... //
Set DIC = CreateObject("Scripting.Dictionary")

'NOTE: I used the worksheet's codename. //
With Sheet2
Set rngData = Range(.Cells(2, "G"), _
.Cells(.Rows.Count, "G").End(xlUp)) _
.Offset(, -3).Resize(, 4)
End With
'// ...and fill just the Keys to get a unique list of salesmen. //
For Each Cell In rngData.Columns(4).Cells
DIC.Item(Cell.Value) = Empty
Next

'// Necessary for late-binding, so we can load ea salesman into another array. //
aryKeys = DIC.Keys
'// 2 slots for ea salesman. First row just holds names, second holds a dictionary //
'// for each, where we can use keys and items to record ea prodict name and amount. //
ReDim aryJaggedOutput(1 To 2, 1 To DIC.Count)

'// Populate output array w/salesmens' names and give ea an empty dictionary. //
For i = 1 To DIC.Count
aryJaggedOutput(1, i) = aryKeys(i - 1)
Set aryJaggedOutput(2, i) = CreateObject("Scripting.Dictionary")
Next

'// Add records to ea Dic, using MATCH to see what salesman's records to add to. //
For Each Cell In rngData.Columns(4).Cells
lRecord = Application.Match(Cell.Value, DIC.Keys)
aryJaggedOutput(2, lRecord).Item(Cell.Offset(, -3).Value) = Cell.Offset(, -1).Value
Next

Set wks = Worksheets.Add(After:=rngData.Parent, Type:=xlWorksheet)

Set rngStart = wks.Range("B2") '<---Change to suit

'// For ea salesman... //
For i = 1 To DIC.Count
'//...plunk his name,... //
rngStart.Value = aryJaggedOutput(1, i)
'//...plunk the headers... //
rngStart.Offset(1).Resize(, 2).Value = Array("Product", "$ Amount")
'// and then, transpose the keys and items, resize ranges to fit, and toss 'em in//
If aryJaggedOutput(2, i).Count > 0 Then
dKeys = Application.Transpose(aryJaggedOutput(2, i).Keys)
dItems = Application.Transpose(aryJaggedOutput(2, i).Items)
rngStart.Offset(2).Resize(UBound(dKeys, 1)).Value = dKeys
rngStart.Offset(2, 1).Resize(UBound(dItems, 1)).Value = dItems
End If
Set rngStart = rngStart.Offset(, 3)
Next
End Sub
I am not sure if I am on the right track, but see if this is close.

[Blanqui]

thank you so much, this is really beyond my VBA knowledge !!


if i want to save the results on the same worksheet i assume i have to change:
Set wks = sheet1
if the order of the columns are modified, which part of the code should be amended?

and same thing for the results if i would like to save the results 10 lines below, how would i modify this part:

'//...plunk his name,... //
rngStart.Value = aryJaggedOutput(1, i)
'//...plunk the headers... //
rngStart.Offset(1).Resize(, 2).Value = Array("Product", "$ Amount")
'// and then, transpose the keys and items, resize ranges to fit, and toss 'em in//
If aryJaggedOutput(2, i).Count > 0 Then
dKeys = Application.Transpose(aryJaggedOutput(2, i).Keys)
dItems = Application.Transpose(aryJaggedOutput(2, i).Items)
rngStart.Offset(2).Resize(UBound(dKeys, 1)).Value = dKeys
rngStart.Offset(2, 1).Resize(UBound(dItems, 1)).Value = dItems
End If
Set rngStart = rngStart.Offset(, 3)
Next

thanks again for your time and your help.