Copy conditionally and paste conditionally

[luvbite38]

Hi Guys,

I want to copy a range conditionally and paste conditionally and hoping that some1 would kindly help me outta er,

Condition to copy

Match the value from CopyTo sheet in ColA with the CopyFrom in ColA.

Condition to paste

Paste if the value is true

See Example below

CopyFrom
Items	RandVals1	RandVals2	RandVals3	RandVals4
Apple	30	32	13	6
Mango	33	34	27	40
Grapes	38	29	47	39
Banana	24	9	19	17
ETC	36	13	34	44

<tbody>
</tbody>

CopyTo	Condition1	Condition2	Condition3	Paste if True in Condition1	Paste if True in Condition2	Paste if True in Condition3
Apple	TRUE	FALSE	FALSE	30
Apple	FALSE	TRUE	FALSE	32	30
Apple	FALSE	FALSE	FALSE	13	32
Apple	FALSE	FALSE	FALSE	6	13
Apple	FALSE	FALSE	FALSE		6
Apple	FALSE	FALSE	FALSE
Apple	FALSE	FALSE	TRUE			30
Mango	TRUE	FALSE	FALSE	33		32
Mango	FALSE	TRUE	FALSE	34	33	13
Mango	FALSE	FALSE	FALSE	27	34	6
Mango	FALSE	FALSE	FALSE	40	27
Mango	FALSE	FALSE	FALSE		40
Mango	FALSE	FALSE	FALSE
Mango	FALSE	FALSE	TRUE			33
Grapes	TRUE	FALSE	FALSE			34
Grapes	FALSE	TRUE	FALSE			27
Grapes	FALSE	FALSE	FALSE			40
Grapes	FALSE	FALSE	FALSE	and So on
Grapes	FALSE	FALSE	FALSE
Grapes	FALSE	FALSE	FALSE
Grapes	FALSE	FALSE	TRUE
Banana	TRUE	FALSE	FALSE
Banana	FALSE	TRUE	FALSE
Banana	FALSE	FALSE	FALSE
Banana	FALSE	FALSE	FALSE
Banana	FALSE	FALSE	FALSE
Banana	FALSE	FALSE	FALSE
Banana	FALSE	FALSE	TRUE

<tbody>
</tbody>

Hope it makes sense.

 

[luvbite38]

Thanks in advance for help me cracking this bad boy

 

[luvbite38]

I can't believe, i fixed it without any help....

if anyone ever need doing something similar use the following code.

Make sure to change the references to meet you need.

Sub FirstArrival()
    Dim rng As Range, r As Range
    With Sheets("ArrivalProfileData")
        Set rng = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 22)
    End With
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In rng.Columns(1).Cells
            Set .Item(r.Value) = r(, 2).Resize(, 21)
        Next
        For Each r In Sheets("Calculation+PTCache").Range("a1").CurrentRegion.Columns(1).Cells
            If (r(, 11) = True) * (.exists(r.Value)) Then
                .Item(r.Value).Copy
r(1, 17).PasteSpecial xlPasteValues, Transpose:=True
            End If
Next
End With
Set rng = Nothing
Application.CutCopyMode = False
End Sub

I am sooooooo happpy "Borat"