Cut and Paste a row in one sheet to another based on a cell value

J

jnksimmons

New member
Joined
Feb 7, 2020
Messages
6
Reaction score
0
Points
0
Excel Version(s)
2019 & 365
Hello!

I have a worksheet that I've made to track progress on projects. I currently have an active x button that when clicked it moves a row from the active worksheet (Project Tracker) to another worksheet (Released). The value that would trigger this action would be in column J (Released). This works perfectly. I would like to have multiple worksheets that have the same names as the project names which are based on different companies that would be selected from a drop-down list (to stop typos). I need help on code to move the cut rows to these certain sheets. Current code:
Code: 
Sub CommandButton1_Click()
        Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      DIM T AS 
      I = Worksheets("PROJECT TRACKER").UsedRange.Rows.Count
      J = Worksheets("RELEASED").UsedRange.Rows.Count
      If J = 1 Then
         If Application.WorksheetFunction.CountA(Worksheets("RELEASED").UsedRange) = 0 Then J = 0
      End If
      Set xRg = Worksheets("PROJECT TRACKER").Range("L1:L" & I)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
          If CStr(xRg(K).Value) = "RELEASED" Then
              xRg(K).EntireRow.Cut Destination:=Worksheets("RELEASED").Range("A" & J + 1)
              xRg(K).EntireRow.Delete
              If CStr(xRg(K).Value) = "RELEASED" Then
                  K = K - 1
              End If
              J = J + 1
          End If
      Next
      Application.ScreenUpdating = True
  End Sub

Thank you,

jnksimmons
 
Last edited by a moderator:
When deleting rows it's best/easiest to work from the bottom up.
This assumes column A has the company names.
Code: 
Sub jnksimmons()
    Dim lr As Long, i As Long
With Sheets("PROJECT TRACKER")
    lr = .Cells(Rows.Count, "L").End(xlUp).Row
    For i = lr To 1 Step -1
        If .Range("L" & i).Value = "RELEASED" Then
            .Rows(i).Copy Sheets(.Range("A" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Rows(i).Delete
        End If
    Next i
End With
End Sub
 
Thank you so much. I am new to this but will make sure I do this everytime from now on.
 
Would you know how to have the cut row pasted into the sheet that has the same name as a cell value in "PROJECT TRACKER" sheet? The cell value would be determined from what is selected as the company in a drop-down list. I can attach my file it that would be helpful.
 
Have you not looked at the suggested macro in post #2 ?
Supplying a file removes the guess work as to what you're working with.
 
Attached File

Thank you so much! I honestly do not know how I missed that. It worked except for one small issue. The row that is being "copied" leaves behind the active x checkbox that is used to output "RELEASED". If I change the code to cut instead of copy it works fine. Will this create issues later? I attached the file. Again, that you.
 

Attachments

  • Project tracker1_share.xlsm
    54.3 KB · Views: 13
Perhaps this will do.
No need for formulas in column A.
I see no point in copying the last 3 columns.
 

Attachments

  • Project tracker1_share_v2.xlsm
    54.6 KB · Views: 21
Last edited:
Too late to edit previous post, you need to already have the headers on the Company sheets or will get a run time error.

Hope this helps.
 
This is exactly what I was looking for. Thank you very much for everything. I need to enroll in an excel vba class. This is something I really would love to learn more about.
 
Glad I could help.


I don't like putting checkboxes on a sheet.
If you have a look at module one in the posted workbook you'll see the macro I alter all the time to put them in for me.
 
I did see it and thank you again. That is so much quicker than what I was doing. I have so much to learn.
 
You must log in or register to reply here.
Back
Top