Code for pasting as per criteria

Hi,

We have discussed this scenario earlier, but I have marked that post as solved hence again raising it as we have more criteria’s.

Attaching sample sheet and code. Everything is same except we are adding 3 more columns .

Some tabs have all these columns where as some has only one or two.

In NCF Data tab , whenever we add “Fund Number”, ”Fund Name”, ”Product Category”, it should add in that particular source group as mentioned in Col. A.

In rest of tabs we can simply add in last row

Thanks

Code not included

Code:

---

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S, FN, sh As Worksheet, tgt As Range
    On Error GoTo Exits
    Application.EnableEvents = False
    If Target.Address = "$B$2" Then
        S = Target.Offset(, -1)
        FN = Target
        For Each sh In Worksheets
            Select Case sh.Name
            Case "FundName Rollup Mapping", "Prod Category Lookup", "Retail Flash NCF by Month"
                Set tgt = sh.Cells(Rows.Count, 2).End(xlUp)(2)
                tgt.Value = FN
            Case "AuM_Data"
                Set tgt = sh.Cells(Rows.Count, 1).End(xlUp)(2)
                tgt.Value = FN
            Case "NCF_Data"
                Set tgt = sh.Columns(1).Find(S, after:=sh.Cells(1, 1), searchdirection:=xlPrevious)
                tgt(2).EntireRow.Insert
                tgt(2).Resize(, 3) = Array(S, "", FN)
            End Select
        Next
    End If
    Target.Offset(, -1).Resize(, 2).ClearContents
Exits:
    Application.EnableEvents = True
End Sub

---

We had added this code in CALC sheet tab in event procedure...Thanks

You should include all your code in the book you post, not rely on previous posts

Note: The code runs when data is entered in Calc Sheet B2

Code:

---

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S, FNum, FName, PC, sh As Worksheet, tgt As Range
    On Error GoTo Exits
    Application.EnableEvents = False
    If Target.Address = "$B$2" Then
        S = Target.Offset(, -1)
        PC = Target.Offset(, 3)
        FName = Target.Offset(, 1)
        FNum = Target
       
        For Each sh In Worksheets            Select Case sh.Name
            Case "NCF_Data"
                Set tgt = sh.Columns(1).Find(S, after:=sh.Cells(1, 1), searchdirection:=xlPrevious)
                tgt(2).EntireRow.Insert
                tgt(2).Resize(, 16) = Array(S, "", FNum, FName, "", "", "", "", "", "", "", "", "", "", "", PC)
            Case "FundName Rollup Mapping"
                Set tgt = sh.Cells(Rows.Count, 1).End(xlUp)(2)
                tgt.Resize(, 2) = Array(FName, FNR)
            Case "Prod Category Lookup"
                Set tgt = sh.Cells(Rows.Count, 1).End(xlUp)(2)
                tgt.Resize(, 4) = Array("", FNum, FName, PC)
          Case "AuM_Data"
                Set tgt = sh.Cells(Rows.Count, 1).End(xlUp)(2)
                tgt.Resize(, 3) = Array(FNum, FName, PC)
            Case "Retail Flash NCF by Month"
                Set tgt = sh.Cells(Rows.Count, 1).End(xlUp)(2)
                tgt.Resize(, 5) = Array("", FNum, FName, "", FNR)
            End Select
        Next
        Target.Offset(, -1).Resize(, 5).ClearContents
    End If
Exits:
    Application.EnableEvents = True
End Sub

---

thank for taking time for this. when it tested it...It only picking up and adding up in cell B2 in calc sheet , where we want values in cell C2,D2 and E2 also to be added in their respective tabs in their respective cell as mentioned in table in the "Var" Sheet.
The process has successfully tested and used for only cell B2 value in previous code. Please suggest. Thanks

Quote:

---

Note: The code runs when data is entered in Calc Sheet B2

---

Use a button instead of the sheet change event.

When I pasted it in Module and try to assign button , it didn't show me any macro to assigned .
Do we need to change anything before I can assign it?

Code:

---

Private Sub Test()
    Dim S, FNum, FName, PC, sh As Worksheet, tgt As Range
    On Error GoTo Exits
    Application.EnableEvents = False
    Set Target = Sheets("CALC Sheet").Cells(2, 2)
    If Target.Address = "$B$2" Then
        S = Target.Offset(, -1)
        PC = Target.Offset(, 3)
        FName = Target.Offset(, 1)
        FNR = Target.Offset(, 2)
        FNum = Target
        For Each sh In Worksheets
            Select Case sh.Name
            Case "NCF_Data"
                Set tgt = sh.Columns(1).Find(S, after:=sh.Cells(1, 1), searchdirection:=xlPrevious)
                tgt(2).EntireRow.Insert
                tgt(2).Resize(, 16) = Array(S, "", FNum, FName, "", "", "", "", "", "", "", "", "", "", "", PC)
            Case "FundName Rollup Mapping"
                Set tgt = sh.Cells(Rows.Count, 1).End(xlUp)(2)
                tgt.Resize(, 2) = Array(FName, FNR)
            Case "Prod Category Lookup"
                Set tgt = sh.Cells(Rows.Count, 1).End(xlUp)(2)
                tgt.Resize(, 4) = Array("", FNum, FName, PC)
          Case "AuM_Data"
                Set tgt = sh.Cells(Rows.Count, 1).End(xlUp)(2)
                tgt.Resize(, 3) = Array(FNum, FName, PC)
            Case "Retail Flash NCF by Month"
                Set tgt = sh.Cells(Rows.Count, 1).End(xlUp)(2)
                tgt.Resize(, 5) = Array("", FNum, FName, "", FNR)
            End Select
        Next
        'Target.Offset(, -1).Resize(, 5).ClearContents
    End If
Exits:
    Application.EnableEvents = True
End Sub

---

That is great....thanks for taking time and solving this....Really appreciate it...