Pick up records in between two days to make a report.

I have a list of payments to be made. Shown in “Member List” which has column for due date.

In the  “PayPeriods” I have the pay periods and the pay day. I want help with VBA code to create a report of the payments that are due.

For example we are working for pay day 22FEB18. I have to pick up all the records that fall between 25JAN18 and 07FEB18.

Code would be helpful.

Thank you

Raghu

EID Name DateDue
123465 JJ10 6-Jan-18
123460 JJ5 11-Jan-18
123466 JJ11 12-Jan-18
123456 JJ1 24-Jan-18
123467 JJ12 31-Jan-18
123458 JJ3 1-Feb-18
123459 JJ4 5-Feb-18
123457 JJ2 7-Feb-18
123461 JJ6 4-Apr-18

 

First Day Last Day Pay Date
19-Oct-17 01-Nov-17 16-Nov-17
02-Nov-17 15-Nov-17 30-Nov-17
16-Nov-17 29-Nov-17 14-Dec-17
30-Nov-17 13-Dec-17 28-Dec-17
14-Dec-17 27-Dec-17 11-Jan-18
28-Dec-17 10-Jan-18 25-Jan-18
11-Jan-18 24-Jan-18 08-Feb-18
25-Jan-18 07-Feb-18 22-Feb-18
08-Feb-18 21-Feb-18 08-Mar-18
Add Comment
7 Answer(s)

Brilliant…Hyside2

 

Thank you very much! Works wonderfully!

 

Expert Answered on February 1, 2018.
Add Comment

Hi, Here is what I did for this.  The workbook has 3 worksheets “Dash”, “Member_List” & “PayPeriods”.

Tab (1)Dash contains a combo box. This box will be used to select the payment date. Note that column”B” is hidden so that we can select data using “Current Region” command in the macro.  The combo box uses cell A2 on tab(1)for its “cell link” and is attached to the macro.

Tab(2) Member_List is data you provided and must be manually updated.

Tab(3) PayPeriods, This data was put into a table so that the combo box on tab(1)Dash is dynamic.  You can simply add new data to this table when needed.

Here are some screen shots:

Tab (1)

RE: Pick up records in between two days to make a report.

Tab(2)

RE: Pick up records in between two days to make a report.

Tab(3)

RE: Pick up records in between two days to make a report.

Back to tab(1) change the date from 25-Jan-18 to 22-Feb-18

This will run the macro and you should now have new data on tab(1)Dash that looks like this:

RE: Pick up records in between two days to make a report.

Here is the [Code]

Sub paymentreport()
Dim r As Range
Dim cc As Integer
Dim wsml As Worksheet
Dim wsdh As Worksheet
Dim wspp As Worksheet
Dim date1 As Date
Dim date2 As Date
Dim rw As Long
Dim i As Integer
Set wsml = Worksheets(“Member_List”)
Set wsdh = Worksheets(“Dash”)
Set wspp = Worksheets(“PayPeriods”)
Set r = Range(“C:C”)

rw = wsdh.Cells(2, 1)
date1 = wspp.Cells(rw, 1) + 1
date2 = wspp.Cells(rw, 2)

Application.ScreenUpdating = False
wsdh.Range(“B:E”).ClearContents
wsml.Range(“A1”).CurrentRegion.Copy Destination:=wsdh.Cells(1, 3)
[E2].Select
cc = Application.WorksheetFunction.CountA(r) – 1
For i = 1 To cc
If ActiveCell.Value < date1 Then
Range(ActiveCell, ActiveCell.Offset(0, -2)).ClearContents
End If
If ActiveCell.Value > date2 Then
Range(ActiveCell, ActiveCell.Offset(0, -2)).ClearContents
End If
ActiveCell.Offset(1).Select
Next i

cc = Application.WorksheetFunction.CountA(r)

If cc < 2 Then GoTo Line1
Columns(“C:E”).Select
ActiveWorkbook.Worksheets(“Dash”).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(“Dash”).Sort.SortFields.Add Key:=Range(“E:E”), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(“Dash”).Sort
.SetRange Range(“C:E”)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Line1:
Range(“A2”).Select
End Sub

Expert Answered on January 30, 2018.
Add Comment

Hi Hyside2,

 

Thanks but I am not able to get to work. Could you please send me the copy? My gmail id is raghu.prabhu[at]gmail.com

 

Thanks

 

Raghu

Expert Answered on January 31, 2018.
Add Comment

Lets try this, it only has two tabs and two tables and is more efficient.

Tab 1= “Member_List” ,  Contains  “Table1”

The “Member_List” contains a combo box .  Assign the combo box to macro “picr”

The combo box is covering cell A1.

The combo box “Cell Link” is cell A1.  And the combo box “Input Range is “Table2” Column “C” on tab PayPeriods. See picture of Form Control.

Form Control:

RE: Pick up records in between two days to make a report.

“Member_List” also has a button named Reset. Assign this button to macro “mlReset”

 

Tab 2 = PayPeriod containing “Table2”

RE: Pick up records in between two days to make a report.

[Code]

Sub picr()

Dim r As Integer
Dim wsml As Worksheet
Dim wspp As Worksheet
Dim date1 As Date
Dim date2 As Date
Set wsml = Worksheets(“Member_List”)
Set wspp = Worksheets(“PayPeriods”)
r = wsml.[A1]
date1 = wspp.Cells(r, 1)
date2 = wspp.Cells(r, 2)

Application.ScreenUpdating = False
wsml.ListObjects(“Table1”).Range.AutoFilter Field:=3, Criteria1:= _
“>” & date1, Operator:=xlAnd, Criteria2:=”<” & date2
[A1].Select
End Sub

———————————————————————————————————-

Sub mlReset()
ActiveSheet.ListObjects(“Table1”).Range.AutoFilter Field:=3
End Sub

———————————————————————————————————-

Expert Answered on January 31, 2018.
Add Comment

Thanks Hyside2. I will consider this closed.

Expert Answered on February 2, 2018.
Add Comment

Hi All,

I have data in 4 columns A:D in the worksheet “Member_List”. The following code is copying the required data in columns of P:R

Hi All,

I have the following code that copies the required data on the same sheet.

Sub CreateReport()
Dim sDate As Date
Dim tDate As Date
Dim PayDay As Date
Dim DueDate As Date
Dim PayCal As String
Dim LastRow As Integer
Dim i As Integer
Sheets("PayPeriod").Select
sDate = Range("G2").Value
tDate = Range("G3").Value
PayDay = Range("G4").Value
PayCal = Range("G5").Value
Sheets("Member_List").Select
Range("P1").Select
ActiveCell.FormulaR1C1 = "Name"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "Due Date"
Range("R1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("P1:R1").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
LastRow = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
For i = 2 To LastRow
DueDate = Cells(i, 2).Value
If (DueDate >= sDate And DueDate <= tDate) And (Cells(i, 4).Value = "No") Then
Range(Cells(i, 1), Cells(i, 3)).Copy
Range("P100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
Application.CutCopyMode = False
Cells(i, 4).Value = "Yes"
End If
Next i
End Sub

I want to alter this code to copy it the required data to another worksheet named “Report”

Regards

Raghu

Expert Answered on February 16, 2018.
Add Comment

SORTED!

 

Private Sub AnotherSheet()
Dim sDate As Date
Dim tDate As Date
Dim PayDay As Date
Dim DueDate As Date
Dim PayCal As String
Dim LastRow As Integer
Dim i As Integer
Sheets("PayPeriod").Select
sDate = Range("G2").Value
tDate = Range("G3").Value
PayDay = Range("G4").Value
PayCal = Range("G5").Value
LastRow = Sheets("Member_List").Range("A" & Rows.Count).End(xlUp).Row
'Sheets("Report").Range("A2:C25").ClearContents
Sheets("Report").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "Name"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Due Date"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("A1:C1").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Sheets("Member_List").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "Name"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Due Date"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("A1:C1").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
LastRow = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
For i = 2 To LastRow
DueDate = Cells(i, 2).Value
If (DueDate >= sDate And DueDate <= tDate) And (Cells(i, 4).Value = "No") Then
Sheets("Member_List").Range(Cells(i, 1), Cells(i, 3)).Copy Destination:=Sheets("Report").Range("A" & Rows.Count).End(xlUp).Offset(1)
Application.CutCopyMode = False
Cells(i, 4).Value = "Yes"
Cells(i, 5).Value = PayCal
End If
Next i
End Sub
Expert Answered on February 16, 2018.
Add Comment
  • Found this useful?

    Please share using the share button above.

    If you found the answer is best answer for your question, Please mark as 'best answer' by clicking on the right tick mark icon at the left side of the answer.

    Found the answer useful and wants to credit the user, then vote the answer (vote up).

  • Your Answer

    By posting your answer, you agree to the privacy policy and terms of service.