Automatically check for last date and insert row below the last date

A

aakhan2011

New member
Joined
Jan 16, 2014
Messages
17
Reaction score
0
Points
0
I have a sheet(Sample.xlsx) in which weekly data is collected and this is done by using the VBA code(Present in Copy 1 and Copy 2 button in Master US.xlsm) written by me. But in my code, it inserts a new after asking two parameters, i.e. line range(i.e. row no for eg A64) and date. I want it to automatically search row containing last date and inserts row below it and this needs to be implemented in "Insert Automatically" and "Insert Date" button using VBA code in Master US.xlsm sheet.I dont have problem with second paramenter.




Logic i want to use :




Itergation of whole page
{
If (col A<>Date)&& col A=Average(i.e. contains average word)
then
inserts row above that row
And then ask for date to enter using date variable.




then inserts row above that row containing last week data in col A.
}


"Insert Automatically" in Master US.xlsm sheet is the button which takes system date and implements the above logic.
"Insert Date" in Master US.xlsm sheet is the button which ask for only date and implements the above logic.


If any other method/ideas to solve this, then it is really appreciated.


Sheets attached.


View attachment Master US.xlsm View attachment Sample.xlsx


Thanks in Advance. :)
 
For others, cross posted: http://www.mrexcel.com/forum/excel-...eck-last-date-insert-row-below-last-date.html

aakhan2011, some light reading: http://www.excelguru.ca/content.php?184-A-message-to-forum-cross-posters

Now try these two macros:
Code: 
Private Sub CommandButton3_Click()  'button labelled "Insert Automatically"
Dim z As Date
Set Source = ActiveSheet.Range("C3:C36")
Set mydata = Workbooks.Open(ThisWorkbook.Path & "\Sample.xlsx")

Set Destn = mydata.Sheets("SingleLine_Activation_Time ").Columns(1).Find(what:="Average", lookat:=xlPart, LookIn:=xlFormulas, searchformat:=False)

If Not Destn Is Nothing Then
  z = Application.InputBox(Prompt:="Enter date")
  Destn.EntireRow.Insert
  Set Destn = Destn.Offset(-1)
  Destn.Offset(, 1).Resize(, Source.Rows.Count).Value = Application.Transpose(Source.Value)
  Destn.Value = z
  mydata.Save
Else
  MsgBox "Couldn't find a cell in column 1 of the destination sheet containing 'Average' above which to insert data."
End If
End Sub

Code: 
Private Sub CommandButton4_Click()  'button labelled "Insert Date"
Dim z As Date
Set Source = ActiveSheet.Range("C3:C36")
Set mydata = Workbooks.Open(ThisWorkbook.Path & "\Sample.xlsx")

Set Destn = mydata.Sheets("SingleLine_Activation_Time ").Columns(1).Find(what:="Average", lookat:=xlPart, LookIn:=xlFormulas, searchformat:=False)

If Not Destn Is Nothing Then
  Destn.EntireRow.Insert
  Set Destn = Destn.Offset(-1)
  Destn.Offset(, 1).Resize(, Source.Rows.Count).Value = Application.Transpose(Source.Value)
  Destn.Value = Date
  mydata.Save
Else
  MsgBox "Couldn't find a cell in column 1 of the destination sheet containing 'Average' above which to insert data."
End If

End Sub
Both the above use the active sheet's range C3:C36 as source data which means you must have the source data sheet active when you run the macro. At the moment, that's a given as (a) the button triggers the macro and that button's on the active sheet and (b) the code is in the source data sheet's code module. However, if you hve multiple source sheets, at the moment you'd need to copy the code multiple times. Instead you could name the above macros differently (say blah1 and blah2, and have them in a standard code module (Insert, Module in the VBE)) then in the button_click event handler have it call blah1 or blah2:
Code: 
Private Sub CommandButton3_Click()  'button labelled "Insert Automatically"
  blah1
End Sub
Code: 
Private Sub CommandButton4_Click()  'button labelled "Insert Date"
  blah2
End Sub

Another way, is to have these two macros as blah1 and blah2 in a standard code module, but instead of using activeX buttons on the sheet as you have, use Form Controls buttons and assign the macro blah1 (or blah2) to them.
 
Stuck somehwere, help reuired

Looks good for above answer.

But when i implement the same for keyword "Total" in the Sample.xlsx i am getting error . Please find the code below . I am using the code in "Insert Automatically" button

Code: 
Public Sub BLAH4()

Dim z As Date
Set Source = ActiveSheet.Range("D3:D36")
Set mydata = Workbooks.Open(ThisWorkbook.Path & "\Sample.xlsx")
Set Destn2 = mydata.Sheets("SingleLine_Activation_Time ").Columns(1).Find(what:="Total", lookat:=xlPart, LookIn:=xlFormulas, searchformat:=False)
If Not Destn2 Is Nothing Then
  z = Application.InputBox(Prompt:="Enter date")
  Destn2.EntireRow.Insert
  Set Destn2 = Destn.Offset(-1)          '' I get error here as "Object Required" "
  Destn2.Offset(, 1).Resize(, Source.Rows.Count).Value = Application.Transpose(Source.Value)
  Destn2.Value = z
  mydata.Save
Else
  MsgBox "Couldn't find a cell in column 1 of the destination sheet containing 'Average' above which to insert data."
End If
End Sub

Code: 
Private Sub CommandButton3_Click()
BLAH
BLAH3
End Sub
 
You're missing the 2:
Set Destn2 = Destn2.Offset(-1)

Each of ther blahs you've written include a line to open the Sample workbook. If you run any of these codes and the file is already open you'll get an error. You'll either need to close the file each time, or check for it already being open before you try to open.
Are you ALWAYS going to be doing the Average insert and the Total insert at the same time and to/from the same sheets? If so they may as well be in the same macro.
 
This is what i have have modified. It am upset as it doesn't works. Can you please check ?

Code: 
Public Sub BLAH()

Dim z As Date
Set Source = ActiveSheet.Range("C3:C36")
Set mydata = Workbooks.Open(ThisWorkbook.Path & "\Sample.xlsx")
Set Destn = mydata.Sheets("SingleLine_Activation_Time ").Columns(1).Find(what:="Average", lookat:=xlPart, LookIn:=xlFormulas, searchformat:=False)
If Not Destn Is Nothing Then
  z = Application.InputBox(Prompt:="Enter date")
  Destn.EntireRow.Insert
  Set Destn = Destn.Offset(-1)
  Destn.Offset(, 1).Resize(, Source.Rows.Count).Value = Application.Transpose(Source.Value)
  Destn.Value = z
  mydata.Save
Else
  MsgBox "Couldn't find a cell in column 1 of the destination sheet containing 'Average' above which to insert data."
End If
 
Dim y As Date
Set Source2 = ActiveSheet.Range("D3:D36")

Set Destn2 = mydata.Sheets("SingleLine_Activation_Time ").Columns(1).Find(what:="Total", lookat:=xlPart, LookIn:=xlFormulas, searchformat:=False)
If Not Destn2 Is Nothing Then
  y = Application.InputBox(Prompt:="Enter date")
  Destn2.EntireRow.Insert
  Set Destn2 = Destn2.Offset(-1)
  Destn2.Offset(, 1).Resize(, Source2.Rows.Count).Value = Application.Transpose(Source2.Value)
  Destn2.Value = y
  mydata.Save
Else
  MsgBox "Couldn't find a cell in column 1 of the destination sheet containing 'Average' above which to insert data."
End If
End Sub
 
Try moving:
Set Source2 = ActiveSheet.Range("D3:D36")
to just below:
Set Source = ActiveSheet.Range("C3:C36")
so that the active sheet is still the sheet with the source data on it rather than the new workbook's sheet when it's opened.
 
Hey @p45cal

Please check , Range C3:c36 is for first table which we are searching 'Average' and Range D3:D36 is for second table which we are searching 'Total' and inserting above it.

Attaching the sheets along with code in button 'Insert Date' and 'Insert Automatically'

View attachment Master US.xlsm

View attachment Sample.xlsx


Any help will be greatly appreciated and then we can close this thread with peace in mind. :)

Regards,
AAK.
 
You must log in or register to reply here.
Back
Top