Add Data Across multiple sheets sorted by date

A

amoverton2

Board Regular
Joined
May 13, 2021
Messages
77
Office Version
  1. 2016
Platform
  1. Windows
Hi All!

So this is a want more than a need but I'm new to VBA and figured maybe there is a wizard on here that might know how to do this... if it can't be done that is cool too, I'll keep doing it manually...

I have a workbook with several sheets acting as a data base that another sheet pulls all the data from those sheets to make a nice tracker. (Eventually, I'd like to separate the database sheets into another workbook for other reasons and another forthcoming post).

I have a multi-page userform where I can add data to all of those sheets on the next available row on every sheet at the same time.

The main sheet tracker is sorted by the date (oldest to newest with today as the oldest as most dates are in the future), not auto filtered since I brought over existing data that was already sorted by date (that
workbook didn't have database sheets).

On the multi-page userform there is a textbox where a date is entered, usually a date in the future (me.txtEDA.value) that goes on sheet "E_ProspectiveGain_Add", column e.

I would like when I click "Save" for excel to look at the date from the textbox (me.txtEDA.value) and compare it with the list of dates on the sheet E_ProspectiveGain_Add/column e, then add a row below the date where it is chronologically appropriate and add all information from the multi-page userform across all of the sheets at the same time (or in order of the vba code).

For example: The date entered (1MAR22) should trigger adding a row below row 5 on every sheet and the information from the multi-page userform is added to row 5 (the former row 6 is now row 7 and so on).

Date in textbox:
1MAR22

List of Dates:
1: 15JAN22
2: 24JAN22
3: 4FEB22
4: 18FEB22
5: 25FEB22
6: 4MAR22
7: 10MAR22
8: 31MAR22
9: 6APR22
10: 15APR22

Here is the code for the current add (Save) button.

VBA Code: 
Private Sub cmdSAVE_Click()

    Dim mpPGI As Long, mpAI As Long, mpTI As Long, mpFI As Long, mpMN As Long, mpAS As Long, mpLC As Long

    mpPGI = ThisWorkbook.Sheets("E_ProspectiveGain_Add").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "A").Value = "=Row()-1"
    Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "B").Value = Me.txtPGNAME.Value
    Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "C").Value = Me.txtRATE.Value
    Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "D").Value = Me.cmbUIC.Value
    Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "E").Value = Me.txtEDA.Value
    Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "F").Value = Me.txtCPHONE.Value
    Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "G").Value = Me.txtWPHONE.Value
    Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "H").Value = Me.txtPEMAIL.Value
    Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "I").Value = Me.txtWEMAIL.Value
    Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "J").Value = Application.UserName
    Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "K").Value = Now

    mpAI = ThisWorkbook.Sheets("E_AdminInfoGain_Add").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "A").Value = "=Row()-1"
    Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "B").Value = Me.txtPGNAME.Value
    Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "C").Value = Me.txtBSC.Value
    Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "D").Value = Me.txtBBDCODE.Value
    Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "E").Value = Me.txtRELRATE.Value
    Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "F").Value = Me.txtRELNAME.Value
    Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "G").Value = Me.txtDETACHCMD.Value
    Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "H").Value = Me.txtEDD.Value
    Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "I").Value = Me.txtADD.Value
    Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "J").Value = Me.cmbOPHOLD.Value
    Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "K").Value = Me.cmbORDMOD.Value
    Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "L").Value = Application.UserName
    Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "M").Value = Now

    mpTI = ThisWorkbook.Sheets("E_TravelInfo_Add").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("E_TravelInfo_Add").Cells(mpPGI + 1, "A").Value = "=Row()-1"
    Sheets("E_TravelInfo_Add").Cells(mpPGI + 1, "B").Value = Me.txtPGNAME.Value
    Sheets("E_TravelInfo_Add").Cells(mpPGI + 1, "C").Value = Me.cmbLOCAL.Value
    Sheets("E_TravelInfo_Add").Cells(mpPGI + 1, "D").Value = Me.cmbARRISLAND.Value
    Sheets("E_TravelInfo_Add").Cells(mpPGI + 1, "E").Value = Me.txtDEPARTCTY.Value
    Sheets("E_TravelInfo_Add").Cells(mpPGI + 1, "F").Value = Me.txtFLTINFO.Value
    Sheets("E_TravelInfo_Add").Cells(mpPGI + 1, "G").Value = Me.txtFLTDATE.Value
    Sheets("E_TravelInfo_Add").Cells(mpPGI + 1, "H").Value = Me.txtLANDTIME.Value
    Sheets("E_TravelInfo_Add").Cells(mpPGI + 1, "I").Value = Application.UserName
    Sheets("E_TravelInfo_Add").Cells(mpPGI + 1, "J").Value = Now

    mpFI = ThisWorkbook.Sheets("E_FamilyInfo_Add").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("E_FamilyInfo_Add").Cells(mpPGI + 1, "A").Value = "=Row()-1"
    Sheets("E_FamilyInfo_Add").Cells(mpPGI + 1, "B").Value = Me.txtPGNAME.Value
    Sheets("E_FamilyInfo_Add").Cells(mpPGI + 1, "C").Value = Me.cmbSPOUSE.Value
    Sheets("E_FamilyInfo_Add").Cells(mpPGI + 1, "D").Value = Me.cmbKIDS.Value
    Sheets("E_FamilyInfo_Add").Cells(mpPGI + 1, "E").Value = Me.cmbPETS.Value
    Sheets("E_FamilyInfo_Add").Cells(mpPGI + 1, "F").Value = Application.UserName
    Sheets("E_FamilyInfo_Add").Cells(mpPGI + 1, "G").Value = Now

    mpMN = ThisWorkbook.Sheets("E_MiscNotes_Add").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("E_MiscNotes_Add").Cells(mpPGI + 1, "A").Value = "=Row()-1"
    Sheets("E_MiscNotes_Add").Cells(mpPGI + 1, "B").Value = Me.txtPGNAME.Value
    Sheets("E_MiscNotes_Add").Cells(mpPGI + 1, "C").Value = Me.txtMISCNOTES.Value
    Sheets("E_MiscNotes_Add").Cells(mpPGI + 1, "D").Value = Application.UserName
    Sheets("E_MiscNotes_Add").Cells(mpPGI + 1, "E").Value = Now

    MsgBox "Information Added"

    ThisWorkbook.Save
    MsgBox "Information Saved"
    
    Call Reset

End Sub

Thanks!!
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Sort by date Sort by votes
macro "Amoverton" = part of your save-button
VBA Code: 
Sub Amoverton2()
     With Sheets("E_ProspectiveGain_Add")
          Set c = .UsedRange.Columns("E")                       'the range, your looking in = column E
          a = c.Value                                           'read to an array

          mydate = MijnDatum("1MAR22")                          'your new date (as double)
          For i = 2 To UBound(a)                                'loop through the array
               datum = MijnDatum(a(i, 1))                       'translate date to a double
               If datum <= mydate Then r = i + 1 Else Exit For  'as long as the date is smaller then your new date, it's the next row, as soon as date is bigger, stop the loop
          Next
          c.Cells(r).EntireRow.Insert                           'insert a row there
          c.Cells(r, 2 - c.Column).Resize(, 11).Value = Array(c.Row - 1, Me.txtPGNAME.Value, Me.txtRATE.Value, Me.cmbUIC.Value, Me.txtEDA.Value, Me.txtCPHONE.Value, Me.txtWPHONE.Value, Me.txtPEMAIL.Value, Me.txtWEMAIL.Value, Application.UserName, Now)     'add your stuff in 1 line
     End With
End Sub

Function MijnDatum(s)
     '*****************************************************
     'this UDF translates an english dateformat "dMMMYY" into a double
     'move this UDF into a normal module
     '*****************************************************
     MijnDatum = 0
     mymonths = [transpose(Text( row(1:12)*28 ,"[$-0809]MMM"))]     'an array with the 12 english months, format MMM
     mymonth = Application.Match(Mid(s, Len(s) - 4, 3), mymonths, 0)     'translate MMM to month number
     On Error Resume Next
     If IsNumeric(r) Then MijnDatum = CDbl(DateSerial(Right(s, 2), mymonth, Left(s, Len(s) - 5)))     'translate that date to a double
End Function
 
Upvote 0
Where should I put this in my code? After all of the adding and before the msgbox's and will it insert a row on all of the sheets or just E_ProspectiveGain_Add
BSALV said:
macro "Amoverton" = part of your save-button
VBA Code: 
Sub Amoverton2()
     With Sheets("E_ProspectiveGain_Add")
          Set c = .UsedRange.Columns("E")                       'the range, your looking in = column E
          a = c.Value                                           'read to an array

          mydate = MijnDatum("1MAR22")                          'your new date (as double)
          For i = 2 To UBound(a)                                'loop through the array
               datum = MijnDatum(a(i, 1))                       'translate date to a double
               If datum <= mydate Then r = i + 1 Else Exit For  'as long as the date is smaller then your new date, it's the next row, as soon as date is bigger, stop the loop
          Next
          c.Cells(r).EntireRow.Insert                           'insert a row there
          c.Cells(r, 2 - c.Column).Resize(, 11).Value = Array(c.Row - 1, Me.txtPGNAME.Value, Me.txtRATE.Value, Me.cmbUIC.Value, Me.txtEDA.Value, Me.txtCPHONE.Value, Me.txtWPHONE.Value, Me.txtPEMAIL.Value, Me.txtWEMAIL.Value, Application.UserName, Now)     'add your stuff in 1 line
     End With
End Sub

Function MijnDatum(s)
     '*****************************************************
     'this UDF translates an english dateformat "dMMMYY" into a double
     'move this UDF into a normal module
     '*****************************************************
     MijnDatum = 0
     mymonths = [transpose(Text( row(1:12)*28 ,"[$-0809]MMM"))]     'an array with the 12 english months, format MMM
     mymonth = Application.Match(Mid(s, Len(s) - 4, 3), mymonths, 0)     'translate MMM to month number
     On Error Resume Next
     If IsNumeric(r) Then MijnDatum = CDbl(DateSerial(Right(s, 2), mymonth, Left(s, Len(s) - 5)))     'translate that date to a double
End Function
Click to expand...
 
Upvote 0
your old part (green with a leading ', to make it remark) is replaced by this part
VBA Code: 
Private Sub cmdSAVE_Click()

     Dim mpPGI As Long, mpAI As Long, mpTI As Long, mpFI As Long, mpMN As Long, mpAS As Long, mpLC As Long


     With Sheets("E_ProspectiveGain_Add")
          Set c = .UsedRange.Columns("E")                       'the range, your looking in = column E
          a = c.Value                                           'read to an array

          mydate = MijnDatum(Me.txtEDA.Value)                   'your new date (as double)-----------> i think this is your date "DMMMYY"
          For i = 2 To UBound(a)                                'loop through the array
               datum = MijnDatum(a(i, 1))                       'translate date to a double
               If datum <= mydate Then r = i + 1 Else Exit For  'as long as the date is smaller then your new date, it's the next row, as soon as date is bigger, stop the loop
          Next
          c.Cells(r).EntireRow.Insert                           'insert a row there
          c.Cells(r, 2 - c.Column).Resize(, 11).Value = Array(c.Row - 1, Me.txtPGNAME.Value, Me.txtRATE.Value, Me.cmbUIC.Value, Me.txtEDA.Value, Me.txtCPHONE.Value, Me.txtWPHONE.Value, Me.txtPEMAIL.Value, Me.txtWEMAIL.Value, Application.UserName, Now)     'add your stuff in 1 line
     End With


'mpPGI = ThisWorkbook.Sheets("E_ProspectiveGain_Add").Range("A" & Rows.Count).End(xlUp).Row
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "A").Value = "=Row()-1"
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "B").Value = Me.txtPGNAME.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "C").Value = Me.txtRATE.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "D").Value = Me.cmbUIC.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "E").Value = Me.txtEDA.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "F").Value = Me.txtCPHONE.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "G").Value = Me.txtWPHONE.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "H").Value = Me.txtPEMAIL.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "I").Value = Me.txtWEMAIL.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "J").Value = Application.UserName
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "K").Value = Now

then the same idea for 
  mpAI = ThisWorkbook.Sheets("E_AdminInfoGain_Add").Range("A" & Rows.Count).End(xlUp).Row
 
Upvote 0
the date in txtEDA and the dates in column E aren't in the format DMMMYY, so that's a lot easier.
No UDF needed.
VBA Code: 
Private Sub cmdSAVE_Click()

     Dim mpPGI As Long, mpAI As Long, mpTI As Long, mpFI As Long, mpMN As Long, mpAS As Long, mpLC As Long


     With ThisWorkbook.Sheets("E_ProspectiveGain_Add")          'this sheet
          ThisWorkbook.Names.Add "mIjnDatum", DateValue(Me.txtEDA.Value)     'defined name "MijnDatum" for the date in txtEDA
          Set c = .Range("A1").CurrentRegion.Columns("E")       'range with the dates in column E
          c.Name = "MijnDatums"                                 'defined name "MijnDatums"
          a = [transpose((mijndatums>mijndatum)*isnumber(mijndatums))]     'mark in an array all the dates>mijndatum as 1
          rij = Application.Match(1, a, 0)                      'row with the 1st 1, thus 1st date greater then MijnDatum
          If Not IsNumeric(rij) Then rij = UBound(a) + 1        'no row find, so next row
          c.Cells(rij).EntireRow.Insert                         'insert a row there
          With c.Cells(rij, 2 - c.Column)                       'in the inserted row
               .Offset(1).Resize(, 11).Copy .Offset(0)          'copy format of next row to this new inserted row
               .Formula = "=ROW()-1"                            '1st cell formule
               .Offset(, 1).Resize(, 10).Value = Array(Me.txtPGNAME.Value, Me.txtRATE.Value, Me.cmbUIC.Value, Me.txtEDA.Value, Me.txtCPHONE.Value, Me.txtWPHONE.Value, Me.txtPEMAIL.Value, Me.txtWEMAIL.Value, Application.UserName, Now)     'add your stuff in 1 line
          End With
     End With


     'starting from here i didn' do anything because i think this is something else

     mpAI = ThisWorkbook.Sheets("E_AdminInfoGain_Add").Range("A" & Rows.Count).End(xlUp).Row
     Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "A").Value = "=Row()-1"
     Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "B").Value = Me.txtPGNAME.Value
     Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "C").Value = Me.txtBSC.Value
     Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "D").Value = Me.txtBBDCODE.Value
     Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "E").Value = Me.txtRELRATE.Value
     Sheets("E_AdminInfoGain_Add").Cells(mpPGI + 1, "F").Value = Me.txtRELNAME.Value
 
Upvote 0
BSALV said:
your old part (green with a leading ', to make it remark) is replaced by this part
VBA Code: 
Private Sub cmdSAVE_Click()

     Dim mpPGI As Long, mpAI As Long, mpTI As Long, mpFI As Long, mpMN As Long, mpAS As Long, mpLC As Long


     With Sheets("E_ProspectiveGain_Add")
          Set c = .UsedRange.Columns("E")                       'the range, your looking in = column E
          a = c.Value                                           'read to an array

          mydate = MijnDatum(Me.txtEDA.Value)                   'your new date (as double)-----------> i think this is your date "DMMMYY"
          For i = 2 To UBound(a)                                'loop through the array
               datum = MijnDatum(a(i, 1))                       'translate date to a double
               If datum <= mydate Then r = i + 1 Else Exit For  'as long as the date is smaller then your new date, it's the next row, as soon as date is bigger, stop the loop
          Next
          c.Cells(r).EntireRow.Insert                           'insert a row there
          c.Cells(r, 2 - c.Column).Resize(, 11).Value = Array(c.Row - 1, Me.txtPGNAME.Value, Me.txtRATE.Value, Me.cmbUIC.Value, Me.txtEDA.Value, Me.txtCPHONE.Value, Me.txtWPHONE.Value, Me.txtPEMAIL.Value, Me.txtWEMAIL.Value, Application.UserName, Now)     'add your stuff in 1 line
     End With


'mpPGI = ThisWorkbook.Sheets("E_ProspectiveGain_Add").Range("A" & Rows.Count).End(xlUp).Row
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "A").Value = "=Row()-1"
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "B").Value = Me.txtPGNAME.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "C").Value = Me.txtRATE.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "D").Value = Me.cmbUIC.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "E").Value = Me.txtEDA.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "F").Value = Me.txtCPHONE.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "G").Value = Me.txtWPHONE.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "H").Value = Me.txtPEMAIL.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "I").Value = Me.txtWEMAIL.Value
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "J").Value = Application.UserName
'Sheets("E_ProspectiveGain_Add").Cells(mpPGI + 1, "K").Value = Now

then the same idea for
  mpAI = ThisWorkbook.Sheets("E_AdminInfoGain_Add").Range("A" & Rows.Count).End(xlUp).Row
Click to expand...
so I was looking at this again with your directions... especially with your last part, the same idea.

I need the date that is entered in the textbox "txtEDA" (which when added goes in column E on sheet E_ProspectiveGain_Add only) to be compared against all the existing dates in column E of sheet E_ProspectiveGain_Add then insert a row where chronologically appropriate on sheet E_ProspectiveGain_Add and the same row on all the rest of the sheets where the rest of data from the multi-page userform will go so everything matches up on the tracker sheet.

If this code does this then cool but I'm not getting it right now.
 
Upvote 0
in CSC i click on that hexagon and get your userform.
Estimated date of arrival, there i click on the agenda and choose a date.
Click on that "save" icon at the bottom
i get "information added" and "information saved"
i go to "e_prospectiveGainAdd and find the new date in the right spot.

What do i do wrong ?
 
Upvote 0
BSALV said:
in CSC i click on that hexagon and get your userform.
Estimated date of arrival, there i click on the agenda and choose a date.
Click on that "save" icon at the bottom
i get "information added" and "information saved"
i go to "e_prospectiveGainAdd and find the new date in the right spot.

What do i do wrong ?
Click to expand...
the date should be at the bottom of the list right? Did you use today's date? If so, the list is now out of order date wise. I want to have the list in correct date order
 
Upvote 0
BSALV said:
in CSC i click on that hexagon and get your userform.
Estimated date of arrival, there i click on the agenda and choose a date.
Click on that "save" icon at the bottom
i get "information added" and "information saved"
i go to "e_prospectiveGainAdd and find the new date in the right spot.

What do i do wrong ?
Click to expand...
the date should be at the bottom of the list right? Did you use today's date? If so, the list is now out of order date wise. I want to have the list in correct date order but all the information on the userform across all the sheets without effecting the other data.

If the macro works, using today's date... should have inserted a row below Thatcher, Marge - 30DEC2021 (row 13) on all sheets and inserted the data from the multi-page userform
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Copy and paste data through multiple workbooks
Replies
2
Views
173
CDaviess
C
M
  • Solved
VBA entry in last row
Replies
5
Views
281
Mohsin110
M
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
1
Views
177
bobaol
B
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
331
Agnarr
Agnarr
S
  • Question
Date formatting issue sheet to VBA Array to Sheet
Replies
2
Views
118
MARK858
MARK858

Forum statistics

Threads
1,214,384
Messages
6,119,201
Members
448,874
Latest member
Lancelots

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