Auto Insert Row With Predictive Data

R

reberryjr

Well-known Member
Joined
Mar 16, 2017
Messages
714
Office Version
  1. 365
Platform
  1. Windows
I am in desperate need of some assistance. I'm trying to teach myself VBA in Excel 2010 and am building an application for a friend. I've come to a point where I'm at a standstill until I can figure this piece out. I've posted this question a couple of times and haven't received any responses, so I'm hoping that if I change the question around a little bit, someone will be willing to assist.

The application tracks several things for her business, where she currently has 30 Clients. The difficult piece for me is tracking payments. As of now, I have everyone on one tab, updated via UserForms. What I'd like to have happen is for the application to "predict" when the next payment is due, and auto-insert a row and copies the data from the most recent entry, into a new row, adjusting the next payment due date.

In other words, a new row would be created using the data in row 3 (red font). All of the information present would be copied into the new row, except the DP Next Due value would say 11/04/17. Another new row would be created using the data in row 6 (red font), except the DP Next Due value would say 1/26/18.

Thoughts?


[TABLE="class: grid, width: 989"]
<colgroup><col span="2"><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]Today[/TD]
[TD]Updated[/TD]
[TD]Status[/TD]
[TD]First[/TD]
[TD]Last[/TD]
[TD]Suffix[/TD]
[TD]Name[/TD]
[TD]DP Status[/TD]
[TD]DP Start[/TD]
[TD]DP Next Due[/TD]
[TD]DP Amt[/TD]
[TD]DP Pymt Date[/TD]
[TD]DP Paid[/TD]
[TD]DP Pymt Status[/TD]
[TD]DP Freq[/TD]
[/TR]
[TR]
[TD="align: right"]12/17/17[/TD]
[TD="align: right"]10/24/17[/TD]
[TD]Active[/TD]
[TD]Jennnifer[/TD]
[TD]Chu[/TD]
[TD][/TD]
[TD]Jennifer Chu[/TD]
[TD]Active[/TD]
[TD="align: right"]09/04/17[/TD]
[TD="align: right"]09/04/17[/TD]
[TD="align: right"]$200.00[/TD]
[TD="align: right"]09/04/17[/TD]
[TD="align: right"]$200.00[/TD]
[TD]Paid Timely[/TD]
[TD]M[/TD]
[/TR]
[TR]
[TD="align: right"]12/17/17[/TD]
[TD="align: right"]10/24/17[/TD]
[TD]Active[/TD]
[TD]Jennnifer[/TD]
[TD]Chu[/TD]
[TD][/TD]
[TD]Jennifer Chu[/TD]
[TD]Active[/TD]
[TD="align: right"]09/04/17[/TD]
[TD="align: right"]09/04/17[/TD]
[TD="align: right"]$200.00[/TD]
[TD="align: right"]10/04/17[/TD]
[TD="align: right"]$200.00[/TD]
[TD]Paid Timely[/TD]
[TD]M[/TD]
[/TR]
[TR]
[TD="align: right"]12/17/17[/TD]
[TD="align: right"]10/24/17[/TD]
[TD]Active[/TD]
[TD]Tom[/TD]
[TD]Smith[/TD]
[TD]Jr.[/TD]
[TD]Tom Smith Jr.[/TD]
[TD]Active[/TD]
[TD="align: right"]12/15/17[/TD]
[TD="align: right"]12/15/17[/TD]
[TD="align: right"]$200.00[/TD]
[TD="align: right"]12/17/17[/TD]
[TD="align: right"]$200.00[/TD]
[TD]Paid Late[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD="align: right"]12/17/17[/TD]
[TD="align: right"]10/24/17[/TD]
[TD]Active[/TD]
[TD]Tom[/TD]
[TD]Smith[/TD]
[TD]Jr.[/TD]
[TD]Tom Smith Jr.[/TD]
[TD]Active[/TD]
[TD="align: right"]12/15/17[/TD]
[TD="align: right"]12/29/17[/TD]
[TD="align: right"]$250.00[/TD]
[TD][/TD]
[TD][/TD]
[TD]Current[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD="align: right"]12/17/17[/TD]
[TD="align: right"]11/30/17[/TD]
[TD]Active[/TD]
[TD]Tom[/TD]
[TD]Smith[/TD]
[TD]Jr.[/TD]
[TD]Tom Smith Jr.[/TD]
[TD]Active[/TD]
[TD="align: right"]12/15/17[/TD]
[TD="align: right"]01/12/18[/TD]
[TD="align: right"]$250.00[/TD]
[TD][/TD]
[TD][/TD]
[TD]Current[/TD]
[TD]B[/TD]
[/TR]
</tbody>[/TABLE]
 
Sort by date Sort by votes
Thank you! Updated can be. DP Pymt Status is a formula, so I suppose copying the cell from the last row and pasting the content into the new row would paste the formula.
 
Upvote 0

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Ok, select the customer's name in Column G that you'd like to insert a new row for, and run this code. How does it work?


Sub Add_Row()
'
' Add_Row Macro
'

'
Dim d As Date, customer As Integer, row As Integer
With Sheets("Sheet1")
customer = Range("G:G").Find(what:=ActiveCell.Value, after:=Range("G1"), searchdirection:=xlPrevious).row + 1
End With
Range("A" & customer).EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(-1, 14).Select
If ActiveCell = "M" Then
ActiveCell.Offset(0, -3).Select
d = DateAdd("m", 1, ActiveCell.Value)
GoTo Insert_Row
ElseIf ActiveCell = "B" Then
ActiveCell.Offset(0, -3).Select
d = DateAdd("d", 14, ActiveCell.Value)
GoTo Insert_Row
ElseIf ActiveCell = "W" Then
ActiveCell.Offset(0, -3).Select
d = DateAdd("d", 7, ActiveCell.Value)
GoTo Insert_Row
Insert_Row:
ActiveCell.Offset(1, -2).Select
ActiveCell.Value = d
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 2).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, -14).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
Range("A1").Select
End If
End Sub

 
Upvote 0
@The_Macrotect, the code is copying and pasting the record I selected, and the appropriate cells. It calculates the added month correctly, but not the biweekly or weekly change.
 
Upvote 0
Hmm, it seems to work for me each time. Is there an error, or is it calculating biweekly and weekly change incorrectly? What is showing up in the cells that should have the biweekly and weekly change?
 
Upvote 0
Try this to get the proper date once you insert the new row

Code: 
public Sub GetPaymentDate(frequency as string)
    dim newDate as string
    dim newRow as integer
  
   With Sheets("MySheet")
      'This will give the last row that has a value---meaning once you copy the new row, you should run this immediately after to change the date
       newRow = .Range("A:A").Find(What:="*", searchDirection:= xlPrevious, lookIn:=xlValues).Row 
       Select Case frequency
          Case "B" : .Range("J" & nextRow) = .Range("J" & nextRow) + 14 'Adds 14 days for Bi-Weekly to previous next payment date
          Case "M" : .Range("J" & nextRow) = .Range("J" & nextRow) + 30 'Adds 30 days for monthly to previous next payment date
          Case "W" : .Range("J" & nextRow) = .Range("J" & nextRow) + 7 'Adds 7 days for weekly to previous next payment date
      End Select
   End With
End Sub
 
Last edited:
Upvote 0
The_Macrotect said:
Ok, select the customer's name in Column G that you'd like to insert a new row for, and run this code. How does it work?


Sub Add_Row()
'
' Add_Row Macro
'

'
Dim d As Date, customer As Integer, row As Integer
With Sheets("Sheet1")
customer = Range("G:G").Find(what:=ActiveCell.Value, after:=Range("G1"), searchdirection:=xlPrevious).row + 1
End With
Range("A" & customer).EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(-1, 14).Select
If ActiveCell = "M" Then
ActiveCell.Offset(0, -3).Select
d = DateAdd("m", 1, ActiveCell.Value)
GoTo Insert_Row
ElseIf ActiveCell = "B" Then
ActiveCell.Offset(0, -3).Select
d = DateAdd("d", 14, ActiveCell.Value)
GoTo Insert_Row
ElseIf ActiveCell = "W" Then
ActiveCell.Offset(0, -3).Select
d = DateAdd("d", 7, ActiveCell.Value)
GoTo Insert_Row
Insert_Row:
ActiveCell.Offset(1, -2).Select
ActiveCell.Value = d
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 2).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, -14).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
Range("A1").Select
End If
End Sub
Click to expand...


That code makes my brain hurt...
 
Upvote 0
Thanks for the constructive replies. I've made some progress, but still have some questions. I've resorted to having 1 financial tab for each Client. What I think will work, is to have code that runs when the workbook opens, that copies the last row on each Client tab. That should give me what I need. The main question I have (at this time) is, can code like that be established for particular sheets? Say there are 30 Clients now and 5 more join next week. Would I have to go in an add code for the 5 new Clients, or can code run against "all sheets except for these 2".
 
Upvote 0
This will loop through all the worksheets in the book, excluding 2
Code: 
Private Sub Workbook_Open()

   Dim Ws As Worksheet
   
   For Each Ws In Worksheets
      If Not Ws.Name = "Sheet1" And Not Ws.Name = "Sheet2" Then
         ' your code
         ' your code
      End If
   Next Ws

End Sub
 
Upvote 0
So, here is where I'm at. Every Client gets their own financial sheet, named with their unique Client ID. What I'm thinking is, the User clicks a command button that launches a form, where they select the Client ID that represents the Client they are updating the financials for. I'm struggling with two things:
1. How to code the scripting dictionary to select the correct sheet. Once the Client ID is selected, the data on that Client's sheet would be presented in the form.
2. How to declare LastRow on multiple sheets, knowing that sheets can be added (not deleted).

Examples of sheet names that I'm working with now are "RB1", "RB2", "RB3", "QJ4".

Here's an example of a scripting dictionary code that I'm using in the application currently:
Code: 
Set coboDict = CreateObject("Scripting.Dictionary")With coboDict
    For Each cStatsClientID In ws1.Range("StatsClientID")
        If Not .exists(cStatsClientID.Value) Then
            .Add cStatsClientID.Value, cStatsClientID.Row
        Else
            If CLng(cStatsClientID.Offset(, -2).Value) > CLng(ws1.Range("B" & .Item(cStatsClientID.Value))) Then
            .Item(cStatsClientID.Value) = cStatsClientID.Row
            End If
        End If
    Next cStatsClientID
    Me.cobo_ClientID.List = Application.Transpose(.keys)
End With
 
Upvote 0
You must log in or register to reply here.

Similar threads

airforceone
  • Solved
Search Row 1 for Text if Found Convert Column to Date
2
Replies
11
Views
1K
airforceone
airforceone
A
  • Question Question
code to copy last row & exclude zero value of the data in last row for each name
Replies
0
Views
291
Abdo
A
Rob_010101
  • Question Question
Filter Data?
2
Replies
16
Views
1K
kevin9999
K
S
  • Question Question
Create New Sheet with Specific Name Based on Variable Cell
Replies
0
Views
219
SBExcel123
S
E
  • Solved
DOUBLE FILTER function to return ONLY records with most recent date when base data is sorted continuously
2
Replies
11
Views
890
Fluff
Fluff

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top