VBA to Copy cells to another sheet based on two values

STEVEMILLS04

Board Regular
Joined
Oct 8, 2009
Messages
113
Good day to all. I have the code below in my spreadsheet that works great as is, however, I need to make some adjustments and not sure how to do so.

First, I would like to make this a button rather than a Worksheet_Change event. How do I transition it to a Macro?
Second, when the code first runs, it should clear all information on rows 3 and on but only in particular tabs. I can manage and type the tab names, just need the basic template on how to program this.
Third, I would like the values of J AND D to drive when a row is copied. I currently just have J2:J. How do I change to code to include the values of D?
Finally, I would love if I could include multiple combinations. By this, I mean if J is Promotable and D is Community Mgr, copy row to the tab named Promotable CM. If J is Well Placed and D is Community Mgr, copy to tab named Well Placed CM. If J is Well Placed and D is Asst Community Mgr, copy to tab named Well Placed ACM. I think you get the idea. I can pre-create these tabs and do all the typing for the code, just need the template as I am not sure how to go about this.

Thank you SOOO MUCH for any help you can provide.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LR As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row
    If Flag = True Then Exit Sub
    If Not Intersect(Target, Range("J2:J" & LR)) Is Nothing Then
        If Target.Value = "Promotable" Then
            LR = Sheets("Test Promotable").Range("A" & Rows.Count).End(xlUp).Row + 1
            Target.EntireRow.Copy
            Sheets("Test Promotable").Range("A" & LR).PasteSpecial
            Flag = True
        End If
    End If
    Application.CutCopyMode = False
    Flag = False
End Sub
 

Some videos you may like

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

ZAX

Well-known Member
Joined
Jul 5, 2012
Messages
715
First,to Change The Code Into a Normal Macro Change The Macro Name,Remove The "Private" Property And Remove Anything Between The Brackets Like The Following Code.
Second,This Macro Will Show an Inputbox To Select The Sheets -I Know This Isn't What You Want But I Don't Know What You Want From Issues "3-4"?
Code:
Sub Copy()
'Code Here..
i = InputBox("Type The Sheet Names Seperated With a Comma"",", "Copy Data")
If i = "" Then
   Exit Sub
End If
If InStr(1, i, ",") > 0 Then
   For l = 1 To Len(i)
       If Mid$(i, l, 1) = "," Then
          commas = commas + 1
       End If
   Next
   s = Split(i, ",")
   For sname = 0 To commas
       Sheets(s(sname)).Select
   Next
Else
   Sheets(i).Select
End If
'Code Here..
End Sub
ZAX
 

STEVEMILLS04

Board Regular
Joined
Oct 8, 2009
Messages
113
Zax, thanks for your help. For issue 3 and 4 they are kind of the same question, I want the code to copy the cells based on a short list of particular values for two columns, where my original code only had one column, which was J and it was only if the cell was equal to one value, where now I need it to be for several values. So, if J is Promotable and D is Community Manager, move to tab Promotable CM. I would want these hardcoded as there are only so many options. Again, if only two examples could be provided, I can copy and paste the code and manually edit. Another example would be if J is Well Placed and D is Community Manager, move to tab named Well Placed CM.
 

ZAX

Well-known Member
Joined
Jul 5, 2012
Messages
715
I Hope This Code Will Help You. :)
Code:
Sub Copy()
Dim LR As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
For Each Cell In Range("D1:D" & LR)
    If Cell.Value = "Community Manager" Then
       If Cell.Offset(0, 6).Value = "Promotable" Then
          Cell.EntireRow.Copy
          Sheets("Promotble CM").Select
          Range("A" & LR + 1).PasteSpecial
          Application.CutCopyMode = False
       End If
    Else
       If Cell.Value = "Community Manager" Then
          If Cell.Offset(0, 6).Value = "Well Placed" Then
             Cell.EntireRow.Copy
             Sheets("Well Placed CM").Select
             Range("A" & LR + 1).PasteSpecial
             Application.CutCopyMode = False
          End If
       End If
    End If
Next
End Sub
ZAX
 

STEVEMILLS04

Board Regular
Joined
Oct 8, 2009
Messages
113
Zax, thank you. We are almost there. Just several issues.

1. The code is only copying one of the instances where the statements are true. For example, the sheet I ran this on has 2 community managers that are promotable and 1 cm that is well placed. It is only copying the 2 instance of the promotable cm and not copying the well placed cm at all.
2. It is copying/pasting the row to line 28 on the new tab. I even deleted and created new tabs and ran it several times, same problem. I made very slight adjustments to the code. The new code is below:

Code:
Sub Copy()
Dim LR As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
For Each Cell In Range("C1:C" & LR)
    If Cell.Value = "Community Mgr" Then
       If Cell.Offset(0, 7).Value = "Promotable" Then
          Cell.EntireRow.Copy
          Sheets("Test Promotable").Select
          Range("A" & LR + 1).PasteSpecial
          Application.CutCopyMode = False
       End If
    Else
       If Cell.Value = "Community Mgr" Then
          If Cell.Offset(0, 7).Value = "Well Placed" Then
             Cell.EntireRow.Copy
             Sheets("Test Well Placed").Select
             Range("A" & LR + 1).PasteSpecial
             Application.CutCopyMode = False
          End If
       End If
    End If
Next
End Sub
 

ZAX

Well-known Member
Joined
Jul 5, 2012
Messages
715
Sorry To Waste Your Time...:oops:
This Code Works Like A Charm.
Code:
Sub Copy()
Dim LR As Long
LR = Cells(Rows.Count, 3).End(xlUp).Row
For Each Cell In Range("C1:C" & LR)
    If Cell.Value = "Community Manager" Then
       If Cell.Offset(0, 7).Value = "Promotable" Then
          Cell.EntireRow.Copy
          Sheets("Test Promotable").Select
          If Range("A1").Value = "" Then
             Range("A1").PasteSpecial
             Application.CutCopyMode = False
          Else
             Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial
             Application.CutCopyMode = False
          End If
       Else
          If Cell.Offset(0, 7).Value = "Well Placed" Then
             Cell.EntireRow.Copy
             Sheets("Test Well Placed").Select
          If Range("A1").Value = "" Then
             Range("A1").PasteSpecial
             Application.CutCopyMode = False
          Else
             Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial
             Application.CutCopyMode = False
          End If
          End If
       End If
    End If
Next
End Sub
ZAX
 

Watch MrExcel Video

Forum statistics

Threads
1,123,304
Messages
5,600,861
Members
414,408
Latest member
macroSmith

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top