Allocation of Data - URGENT HELP

[asheesh3337]

Dear Friends,

KINDLY HELP with the attached .xlsx file as per the given conditions. I would like to thank in advance. I know you will be able to help me write a VBA Code for the same.


There is an INPUT DATA (A2:F6) and an OUTPUT DATA (A11:M14).


The output data has been manually filled following the given conditions :-


1. To Copy :- Copy cells between B3 and F6. If B3 = 0, then skip to next row starting from B4.


2. To Paste in the output data, Paste such that :-


a) Condition for ROW :- If the contents of A11 belong to A2:A6, then only fill row 11. For example, A11 (A) is a part of A3 (A,B,C), A4 (A,B), A5 (A,C). So, only copy the contents of Row 3,4 and 5 and paste in row 11. Note that A11 (A) is not a part of A6 (B,C), so row 6 hasn't been copied.


b) Condition for COLUMN :- If in the output data, sum = 0, only then start pasting the data of the next row of input data. eg. if sum in B14 = 0, only then paste data of B3. if sum in C14 = 0, only then paste data of C3.


c) If the location of Output data does not belong to the location of input data, then do not copy paste the corresponding data. eg. Since 46 and 41 belong to all A,B and C, 46 and 41 have been copied to row 11, 12 and 13 (i.e. all locations A, B and C). Another example, since 11,11,11,11 and 5 belong to A and B only, it has been copied to row 11 and 12 (i.e locations of A and B only). Meanwhile row 13 i.e. Location C has been kept empty.


For convenience, color coding of data has been done.

[offthelip]

I don't understand your description of the logic at all, but this will copy the data from A3:f6 to the A11 to match the data you have got there at the moment.

Sub test()inarr = Range("a3:f6")
outarr = Range("a11:m13")
 Dim cnt As Long
 cnt = 2
For i = 1 To 4
  For m = 2 To 6
      If inarr(i, m) = 0 Then
         Exit For
      Else
        For j = 1 To 3
         If InStr(inarr(i, 1), outarr(j, 1)) Then
                     outarr(j, cnt) = inarr(i, m)
                    End If
                      
         Next j
        cnt = cnt + 1
        


      End If
  Next m


Next i


Range("a11:M13") = outarr




End Sub

[mdmackillop]

Option Base 1
Sub Test()
    arr = Array("A", "B", "C")
res = Range("A11:M13")
    Set R = Range("A3:A6")
    Set Rng = R.Resize(, 6)


    For Each a In arr
        x = 2: y = 2: Z = Z + 1
        For i = 1 To Rng.Rows.Count
            If InStr(1, Rng(i, 1), a) > 0 Then
                res(Z, 1) = a
                x = 2
                Do
                    res(Z, y) = Rng(i, x)
                    x = x + 1
                    y = y + 1
                Loop Until Rng(i, x) = 0
            Else
                x = 2
                Do
                    res(Z, y) = 0
                    x = x + 1
                    y = y + 1
                Loop Until Rng(i, x) = 0
            End If
        Next i
        Range("A11").Offset(b).Resize(, 13) = res
        b = b + 1
        Z = 0
    Next a
End Sub