Unable to get rows to move to other sheets with VBA based on cell drop down text entry

**robfhiuo** · 01-09-2015, 08:11 AM

Hello,

I have a worksheet that I am using to track which of our quotations are in a status of "Active", "Stale", "Lost", "Submitted" or "Accepted". These statuses are stored in the "References" tab and can be selected via a drop down menu on the main "Quotation_Register" tab. Up until now, I have employed conditional formatting with a color coded scheme that allows me to easily identify which rows fall under which condition (other than Active or Submitted, which need to remain in the "Quotation_Register" sheet until they are either lost, stale or Accepted) and then manually cut and paste the "Stale", "Lost" and "Accepted" quotations to their relevant tabs: "Stale_Quotations", "Lost_Quotations" and "Works_in_Progress" respectively. I would like to automate this so that once one of those 3 last statuses is selected, that entire row will auto cut and paste to the next available free line on the relevant tab and the then empty rows on the "Quotation_Register" tab will be removed. I have attempted quite a few solutions as outlined by other members in similar threads on a number of sites, including this one. Unfortunately, I have been unsuccessful in getting this to work at all. I have even tried rearranging my template to match the code, but also, without success. I hope I have adequately described my problem and have complied with the rules for thread posting. I would greatly appreciate any help from fellow members. I have attached a clean copy of the register for further clarity. Many thanks in advance.

**Tinbendr** · 01-11-2015, 05:59 PM

This seems to work. Copy to standard module.

Sub ParseByStatus()
Dim WS As Worksheet
Dim WSdest As Worksheet
Dim LastRow As Long
Dim LRDest As Long
Dim A As Long

Set WS = Worksheets("Quotation_Register")
With WS
    LastRow = .Cells(.Rows.Count, "S").End(xlUp).Row
    
    For A = LastRow To 5 Step -1
        Select Case UCase(.Range("S" & A))
        Case "STALE"
            Set WSdest = Worksheets("Stale_Quotations")
            CopyDelete WS, WSdest, A

        Case "LOST"
            Set WSdest = Worksheets("Lost_Quotations")
            CopyDelete WS, WSdest, A
        
        Case "ACCEPTED"
            Set WSdest = Worksheets("Works_in_Progress")
            CopyDelete WS, WSdest, A
        
        End Select
    Application.CutCopyMode = False
    Next
End With
End Sub

Sub CopyDelete(WS As Worksheet, WSdest As Worksheet, CurRow As Long)
With WSdest
    LRDest = .Cells(.Rows.Count, "A").End(xlUp).Row
    If LRDest < 4 Then LRDest = 4
    WS.Rows(CurRow).Copy WSdest.Rows(LRDest + 1)
    WS.Rows(CurRow).EntireRow.Delete
End With
End Sub

**robfhiuo** · 01-12-2015, 02:27 AM

Thank You Tinbendr

Works like a charm.

Many, many thanks - very much appreciated.

Unable to get rows to move to other sheets with VBA based on cell drop down text entry

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Unable to get rows to move to other sheets with VBA based on cell drop down text entry

Re: Unable to get rows to move to other sheets with VBA based on cell drop down text entry

Re: Unable to get rows to move to other sheets with VBA based on cell drop down text entry

Thread Information

Users Browsing this Thread

Similar Threads

move rows to new sheet based on text and date in multiple sheets

Move active cell based on drop down selection

Restrict entry in various cells based on drop down choice in another cell

Insert Rows Based on text Box Entry in User Form

Unable to Edit Userform, unable to resize, move any objects, unable to right click

Bookmarks

Bookmarks

Posting Permissions