Help please to move row to a second archive sheet when a Marlett tick is selected in cell

Danz1985,

It appears that you did not attach your sample file. Please do so and I will try to look at it for you.

Thanks,

DarkF1ame

Thanks DarkF1ame,

I'm having issues uploading on this connection. The file size is 39mb so I think I may be exceeding limit.

Originally Posted by DarkF1ame

Danz1985,

It appears that you did not attach your sample file. Please do so and I will try to look at it for you.

Thanks,

DarkF1ame

Managed to reduce the file size and attached now. Cheers

I believe that replacing your first Selection Change event sub with the one below will have the desired result. I noticed on the sample you attached that you'll also need to switch column 'O' of the archive sheet to Marlett font as well if you want the Marlett tick to transfer (it currently shows up as "a")

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub

        If Not Intersect(Target, Range("J7:J100,K7:K100,L7:L100,M7:M100,N7:N100,O7:O100")) Is Nothing Then

            Target.Font.Name = "Marlett"

                If Target = vbNullString Then

                    Target = "a"

                Else

                    Target = vbNullString

                End If
                If Target.Column = 15 Then
                    Dim TarRow As Long
                    Dim NextRow As Long

                    TarRow = Target.Row
                    If Sheets("Archive Sheet").Range("D7").Value = "" Then
                        Sheets("Archive Sheet").Range("D7:Q7").Value = Sheets("Current Job Sheet").Range("D" & TarRow & ":Q" & TarRow).Value
                        Sheets("Current Job Sheet").Range("D" & TarRow & ":Q" & TarRow).Delete Shift:=xlUp
                    Else
                        NextRow = Sheets("Archive Sheet").Range("D" & Rows.Count).End(xlUp).Offset(1).Row
                        Sheets("Archive Sheet").Range("D" & NextRow & ":Q" & NextRow).Value = Sheets("Current Job Sheet").Range("D" & TarRow & ":Q" &TarRow).Value
                        Sheets("Current Job Sheet").Range("D" & TarRow & ":Q" & TarRow).Delete Shift:=xlUp
                    End If
                End If
        End If

End Sub

Originally Posted by cantosh

I believe that replacing your first Selection Change event sub with the one below will have the desired result. I noticed on the sample you attached that you'll also need to switch column 'O' of the archive sheet to Marlett font as well if you want the Marlett tick to transfer (it currently shows up as "a")

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub

        If Not Intersect(Target, Range("J7:J100,K7:K100,L7:L100,M7:M100,N7:N100,O7:O100")) Is Nothing Then

            Target.Font.Name = "Marlett"

                If Target = vbNullString Then

                    Target = "a"

                Else

                    Target = vbNullString

                End If
                If Target.Column = 15 Then
                    Dim TarRow As Long
                    Dim NextRow As Long

                    TarRow = Target.Row
                    If Sheets("Archive Sheet").Range("D7").Value = "" Then
                        Sheets("Archive Sheet").Range("D7:Q7").Value = Sheets("Current Job Sheet").Range("D" & TarRow & ":Q" & TarRow).Value
                        Sheets("Current Job Sheet").Range("D" & TarRow & ":Q" & TarRow).Delete Shift:=xlUp
                    Else
                        NextRow = Sheets("Archive Sheet").Range("D" & Rows.Count).End(xlUp).Offset(1).Row
                        Sheets("Archive Sheet").Range("D" & NextRow & ":Q" & NextRow).Value = Sheets("Current Job Sheet").Range("D" & TarRow & ":Q" &TarRow).Value
                        Sheets("Current Job Sheet").Range("D" & TarRow & ":Q" & TarRow).Delete Shift:=xlUp
                    End If
                End If
        End If

End Sub

That is truly amazing. I can't thank you enough.

I'll put the sheet into place over the next week or so and give it a good run out.

Thanks again.