VBA Code Help.. Please :)

[VBAN0oB]

I am trying to develop a business tracker that is not a manual process. I need it to do the following:
1. If we received a submission the data is entered in lets say A2:N2 and the boss wants the rows colored alternating blue. -- I've done this with conditional formatting, however the number of rows above the [BOUND ACCOUNTS] merged cells fluctuates when we get new submissions or decline them.
2. If we bind the submission then we put the bound premium in K2 and the row needs to be cut/paste below the [BOUND ACCOUNTS] merged cells on the spreadsheet, but then the rows below bound accounts are colored alternating green.- My code does this but not correctly.
3. If the user puts a premium in column K in error and it moves below, then they remove the premium I need it to move back up above [BOUND ACCOUNTS]
4. If we do not bind the account then we put a P in column A and the row cuts/pastes to sheet (pipeline) -- My current code does this part
5. If we decline the account then we put a D in column A and the row cuts/pastes to sheet (declined)-- I am not sure how to add another rule for this
6. Lastly I need the accounts to be sorted in date order newest to oldest automatically without the end user having to manually click sort each time.

I realize that this is super extra, but our other systems are so antiquated that EVERYTHING is done via excel right now and its very time consuming. If you are so able and willing, please help. My eyeballs can't take anymore YouTube videos at 3 am.

Here is what I have under module "October"

Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' Run a macro that is located inside of a module
    Call Worksheet_SelectionChangeOctober
  End Sub

Sub MoveBasedOnValueOctober()
    Call MoveBasedOnValueOctober
End Sub

Sub Worksheet_SelectionChangeOctober()
'Updated by Extendoffice 20220520
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xEndRow As Long
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
lOne:
    Set xRg = Range("K2:K50")
    If xRg Is Nothing Then Exit Sub
    If xRg.Columns.Count > 1 Or xRg.Areas.Count > 1 Then
        GoTo lOne
    End If
    xEndRow = xRg.Rows.Count + xRg.Row
    Application.ScreenUpdating = False
    For I = xRg.Rows.Count To 1 Step -1
        If xRg.Cells(I) > 0 Then
        xRg.Cells(I).EntireRow.Cut
        Rows(xEndRow).Offset(3, 0).EntireRow.Insert
    End If
    Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Here is what I have under Sheet7 (October)

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Run a macro that is located inside of a module
    Call Worksheet_SelectionChangeOctober
    Call MoveBasedOnValueOctober
End Sub

Sub MoveBasedOnValueOctober()
'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("October").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("October").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

 

[RoryA]

Welcome to the forum.

To be honest, given that you have 365, I wouldn't use code at all. I'd suggest one sheet with a table where all the submissions are entered, then something like a sheet each for Bound, Pipeline and Declined using a simple FILTER formula to extract the relevant data to each. Or using Power Query so that you get a banded table automatically.

 

[VBAN0oB]

Thank you for your advice, however that will not work for the mgmt team I am dealing with. If someone could help me with the code to move from one table to another on the same sheet maybe that would be easier.

 

[vw412]

I started working on this and have some ideas to help but it would help greatly if you could upload to Dropbox (or other such) a representative workbook to use as testing. I will have additional questions but for now try to upload that workbook.