Moving entire row based on cell value VBA

[HHutton]

Hello,

I need assistance with VBA to move a row to another sheet.

I have 300+ rows of data in a sheet called "MASTER". A status marker (A or X) is placed in column T. When an X is placed in column T, I would like the entire row (including blanks to save structure) to be moved to the sheet called, "Inactive". I have a code inserted, but it's not working. It is moving the entire set of data to the other sheet, not just a single row. It's also leaving the original data and not deleting it after pasting to the other sheet.

It's in conjunction with another (working) code that is very important for the file, and maybe that's the issue. I have the first working code in the part that's worksheet specific and the one that's malfunctioning is in a module.

I am extremely inexperienced in VBA and I'm not sure how to fix this.

Any help is appreciated!

Code is pasted below:

Thanks!!!

Option ExplicitSub Hutton()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("MASTER")
Set s2 = Sheets("Inactive")
Dim lr As Long, lr2 As Long
Dim i As Long
lr = s1.Range("T" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To lr
lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
If s1.Range("T" & i) = "A" Or s1.Range("T" & i) = "X" Then
s1.Range("T" & i).EntireRow.Copy s2.Range("A" & lr2 + 1)
End If
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[mumps]

When you say "worksheet specific", it sounds like you have a Worksheet event macro. Could you post that macro? The macro as you have it in your post loops through all rows and if any cell in column T has an A or an X, it moves all those rows. If you only want to move one row, how do you determine which row to move?

 

[HHutton]

The macro in the worksheet is:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)


MyPath = "P:\PERSONNEL FOLDERS\OFFICE STAFF\Heather\Pics for Heather to put into tracker\"
StartRow = 1
EndRow = 500
MyEnd = ".JPG"


x = 0


For i = StartRow To EndRow
    If Len(Cells(i, 3).Value) > 0 Then
        MyFileName = ""
        MyFileName = Dir(MyPath & Cells(i, 3).Text & MyEnd, vbNormal + vbDirectory)


        If MyFileName <> "" Then
            x = x + 1
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), _
                        Address:=MyPath & Cells(i, 3).Text & MyEnd
        End If
    End If
Next i


End Sub

It is to hyperlink a picture to another cell in the "MASTER" sheet.

The code to move rows should only move a single row if column T is an X, not both. I had help writing this VBA, so I'm not sure how to fix it.

Thanks for the help!

 

[HHutton]

Also, should I paste the code for moving rows in the worksheet after the code above, or a module as I have done? I wasn't sure if they would work well in the same area and the image hyperlink code is crucial to my spreadsheet.

 

[mumps]

You said:

The code to move rows should only move a single row if column T is an X

If there are more than one row that contain an X in column T, how do you decide which row to move? Also, your Worksheet_Change macro doesn't specify which cell or cells trigger the macro when they are changed. Is the macro triggered when you enter a value in column C? Your macro also loops down to row 500. Will you always have data down to that row?

 

[HHutton]

So all of column T has A's until I am alerted that a vehicle is being decommissioned. At that point I change the A in column T to an X. At that point I would like them to automatically move to the sheet "Inactive." Sorry I wasn't more clear. They are all A's at this point as I've just started this project.

 

[HHutton]

As for the second question, yes the Worksheet_Change macro is triggered when column C is filled. It then locates the filepath and matches the filename with what's in column C and creates a hyperlink. That macro is working.

 

[mumps]

You can do everything you need using this macro in the worksheet code module:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Intersect(Target, Range("C:C,T:T")) Is Nothing Then Exit Sub
    Dim bottomC As Long, rng As Range
    bottomC = Range("C" & Rows.Count).End(xlUp).Row
    Select Case Target.Column
        Case Is = 3
            MyPath = "P:\PERSONNEL FOLDERS\OFFICE STAFF\Heather\Pics for Heather to put into tracker\"
            For Each rng In Range("C1:C" & bottomC)
                If rng <> "" Then
                    MyFileName = ""
                    MyFileName = Dir(MyPath & rng.Value & ".jpg", vbNormal + vbDirectory)
                    If MyFileName <> "" Then
                        ActiveSheet.Hyperlinks.Add Anchor:=rng, Address:=MyPath & rng.Value & ".jpg"
                    End If
                End If
            Next rng
        Case Is = 20
            If Target = "X" Then
                Target.EntireRow.Copy Sheets("Inactive").Cells(Sheets("Inactive").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
    End Select
End Sub

I've modified the part that adds the hyperlinks. See if it works for you. If not, you can replace that part with your original code. Do you really need to loop through all the values in column C? Would it work for you if the hyperlinks were created each time you fill in a cell in column C for that row only. That means that the hyperlink would be added one row at a time as you fill in column C. The way it is currently written, every hyperlink is created for every row when only one cell in column C has been filled.

 

[HHutton]

Wow thank you! I had no idea it could be done with one macro! You're awesome!

I do need it to loop through. I'm creating this for someone else, so the filepath will change, so the hyperlinks will need to be updated once that happens. I will try this and see how it works.

Thank you for all your help!!!

 

[mumps]

You are very welcome.