VBA Code Help. Need to cut/paste rows to different sheets based on different criteria & sort by date

[VBAN0oB]

Hello! I have a workbook with 12 sheets (named each month fully spelled out) and I need to move rows from each monthly sheet as follows:

If Column A reflects the word Pipeline I need the row to cut/paste to the Pipeline worksheet (in the same workbook)
If Column K reflects a value greater than $0 I need the row to cut/paste to the Bound worksheet (in the same workbook)

I need every worksheet within the workbook to sort by date which is in Column H in every sheet.

Currently, I have a code that moves the pipeline which is as follows:

Sub MoveBasedOnValueNovember()
'Created by Excel 10 Tutorial
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets("November").UsedRange.Rows.Count
B = Worksheets("Pipeline").UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Pipeline").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("November").Range("A1:A" & A)
On Error Resume Next
Application.ScreenUpdating = False
For A = 2 To xRg.Count
If CStr(xRg(A).Value) = "Y" Then
xRg(A).EntireRow.Copy Destination:=Worksheets("Pipeline").Range("A" & B + 1)
xRg(A).EntireRow.Delete
If CStr(xRg(A).Value) = "Y" Then
A = A - 1
End If
B = B + 1
End If
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
Selection.End (xlUp)
End Sub

I also have the following to call the Macros automatically

Private Sub Worksheet_Change(ByVal Target As Range)
' Run a macro that is located inside of a module
Call Worksheet_SelectionChangeNovember (this macro is moving the rows that have Pipeline in Column A)

Call MoveBasedOnValueNovember (this macro is currently moving the row column K is greater than $0 to the bottom of the monthly sheets. But I want it to now move to its own worksheet instead of to the bottom of each months.)

End Sub

Your assistance would be much appreciated.

 

[VBAN0oB]

So far this is the code that I have. The screen flickers which is weird. But the sort function is not working. I need it to sort across all sheets in the workbook. Essentially, rows from the monthly sheet (Nov) are moved to either Pipeline (P), Issued (I) or Declined (D). Once the rows from November are moved to the other sheets I need it to sort those sheets. Please help, this has been weeks of research, I get one step forward and 10 back.

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Cut/Paste rows based on cell value A
'Declare variables
    Dim sheetNo1 As Worksheet
    Dim sheetNo2 As Worksheet
    Dim sheetNo3 As Worksheet
    Dim sheetNo4 As Worksheet
    Dim tbl2 As ListObject
    Dim tbl3 As ListObject
    Dim tbl4 As ListObject
    Dim FinalRow As Long
    Dim Cell As Range
'Set variables
    Set sheetNo1 = Worksheets("November")
    Set sheetNo2 = Worksheets("Pipeline")
    Set sheetNo3 = Worksheets("Issued")
    Set sheetNo4 = Worksheets("Declined")
    Set tbl2 = sheetNo2.ListObjects("Pipeline")
    Set tbl3 = sheetNo3.ListObjects("Issued")
    Set tbl4 = sheetNo4.ListObjects("Declined")
'Type a command to select the entire row
    Selection.EntireRow.Select
' Define destination sheets to move row
    FinalRow1 = sheetNo1.Range("D" & sheetNo1.Rows.Count).End(xlUp).Row
    FinalRow2 = sheetNo2.Range("D" & sheetNo2.Rows.Count).End(xlUp).Row
    FinalRow3 = sheetNo3.Range("D" & sheetNo3.Rows.Count).End(xlUp).Row
    FinalRow4 = sheetNo4.Range("D" & sheetNo4.Rows.Count).End(xlUp).Row
    With sheetNo1
'Apply loop for column A until last cell with value
    For Each Cell In .Range("A1:A50" & .Cells(.Rows.Count, "D").End(xlUp).Row)
'Apply condition to match the "Pipeline" value
        If Cell.Value = "P" Then
    sheetNo2.Activate
    tbl2.ListRows.Add
    R = tbl2.Range.Rows.Count
    sheetNo1.Activate
    'Command to Copy and move to a destination Sheet "Pipeline"
            .Rows(Cell.Row).Copy Destination:=sheetNo2.Rows(FinalRow2 + 1)
            .Rows(Cell.Row).Delete
            FinalRow2 = FinalRow2 + 1
'Apply condition to match the "Issued" value
        ElseIf Cell.Value = "I" Then
    sheetNo3.Activate
    tbl3.ListRows.Add
    R = tbl3.Range.Rows.Count
    sheetNo1.Activate
'Command to Copy and move to a destination Sheet "Issued"
            .Rows(Cell.Row).Copy Destination:=sheetNo3.Rows(FinalRow3 + 1)
            .Rows(Cell.Row).Delete
             FinalRow3 = FinalRow3 + 1
             'Apply condition to match the "Bound" value
        ElseIf Cell.Value = "D" Then
    sheetNo4.Activate
    tbl4.ListRows.Add
    R = tbl4.Range.Rows.Count
    sheetNo1.Activate
'Command to Copy and move to a destination Sheet "Declined"
            .Rows(Cell.Row).Copy Destination:=sheetNo4.Rows(FinalRow4 + 1)
            .Rows(Cell.Row).Delete
             FinalRow4 = FinalRow4 + 1
        End If
     Next Cell
    End With
  End Sub



Private Sub Worksheet_ChangeSortNov(ByVal Target As Range)

    Call SortNov
    Call SortIss
    Call SortDec
    Call SortPipe
  
End Sub

 

[vw412]

I am looking at your code to try to help, but it would be very helpful if you could upload a representative workbook to Dropbox (or other such site) so I can run code to test.

 

[psgoldberg]

I'm sure that you will eventually find the right macro code. However, it really seems that this is an easy application of the Advanced Filter command which allows you to copy rows of a table (and subsets of the row, if desired) to another location (e.g., Bound or Pipeline) based on a defined criteria. Once you have the mechanics of that figured out, the macro to execute will be 10 lines or less, I expect. The Advanced Filter command is a very old technique (inherited from Lotus 1-2-3) which is not too well known but extremely helpful - as your use case suggests.

 

[VBAN0oB]

I am looking at your code to try to help, but it would be very helpful if you could upload a representative workbook to Dropbox (or other such site) so I can run code to test.

I am not able to download the file sharing program that mrexcel offers. Is there another way

 

[Fluff]

You can upload your file to a share site such as OneDrive, GoogleDrive, Dropbox. Then mark for sharing & post the link you are given to the thread.

 

[VBAN0oB]

I am looking at your code to try to help, but it would be very helpful if you could upload a representative workbook to Dropbox (or other such site) so I can run code to test.

Here is the link

https://docs.google.com/spreadsheet...ouid=104990479649387456522&rtpof=true&sd=true

 

[psgoldberg]

From my perspective, the use case here is a bit unclear. What you are attempting to do is to run the macro after each time a cell is entered which doesn't make too much sense to me. How is this workbook used - is all the data entered and then you rearrange it? If so, you just need to run a routine once which would be pretty easy if not automatic with some use of the Filter function. Or use a form to enter data and then put the data in the right place. Just trying to fix/adjust what you have here is problematic.

See this post for an elegant approach to a very similar problem.

 

[VBAN0oB]

Thank you everyone who is attempting to help me help myself LOL. So the workbook's purpose is this:

1. Each month new business that is submitted to us is manually logged from 3 different green screen based systems
2. After an underwriter reviews the account it is either (Pipeline, Issued, Declined are represented in column A drop down as P, I & D accordingly)
A. declined because it doesn't fit what we will insure
B. Quoted, at which point we enter the quoted premium on the month tab in column J. If it is bound, the premium gets entered in column K and the row turns green to indicate that it is to be bound.
C. Issued is where it will go after it is completely issued in one of the DOS systems and a policy number is assigned to it.
D. Pipeline is where it will go if it is something that is within our appetite however we didn't win the business this year.

It is a constantly evolving document between 15 underwriters and 5 managers and is updated all day every day. I know that my VBA code is ridiculously long. That is a result of me pulling dozens of codes from the interweb and morphing it.

 

[VBAN0oB]

**Edited to add** I am unable to use one worksheet to enter all of the data for all of the incoming accounts because the sheet also tracks the quoted/bound/premium to goal and accounts to goal.