Copy data if dates are matched

Vincent88

Active Member
Joined
Mar 5, 2021
Messages
337
Office Version
  1. 2019
Platform
  1. Windows
  2. Mobile
Hi EveryOne, I need to copy the data of the last 5 days from previous-month sheet (let says sheetname is 202109) to a newly created sheet, the following month of previous month (let says sheetname is 202110).
SheetName is in format(yyyymm)
Of all sheets, Row 1 from Column C to AL states the dates from 5 days in previous month + total days in the month of the sheetname.
The destination cells In new sheet to paste will always be from column C to G whereas the position of the last 5 days of previous month in previous sheet will be varied becuz numbers of days in every month is varied particular in February. See images attached.
My code is hardcoded the sheetname and cells' addresses of previous month. Need assistance to amend them since it will be a routine job to do when a new-month sheet is created.

VBA Code:
Sub LastMonthData17()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range
    Dim c As Range, f As Range
    Dim lastrow1 As Long
    Dim lastrow2 As Long
    Dim rng1Col As Range, rng2Col As Range

    Set ws1 = Sheets("202108")   'Need to Change to previous month of ActiveSheetName
    Set ws2 = ActiveSheet
    
    lastrow1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    lastrow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    
    Set rng1 = ws1.Range("A3:AL" & lastrow1)
    Set rng2 = ws2.Range("A3:G" & lastrow2)
    
    Set rng1Col = ws1.Range("A3:AL" & lastrow1).Columns(1)      'Column A in Sheet of previous month
    Set rng2Col = ws2.Range("A3:G" & lastrow1).Columns(1)       'Column A in Activesheet
          
    For Each c In rng1Col.Cells
        Set f = rng2Col.Find(c.Value, , xlValues, xlWhole)
      
        'Search the last 5 days of previous month then copy & paste to column C:G in ActiveSheet
        If Not f Is Nothing Then
               f.Offset(, 2).Resize(, f.Columns.Count + 4).Value = _
               c.Offset(, 33).Resize(, c.Columns.Count + 4).Value     'Need to amend also'
        End If
     Next c
    
    'IF NO MATCH, THEN PUT BLANK IN CELLS
     For Each c In rng2Col
        If IsEmpty(c.Value) Then f.Offset(, 2).Resize(, f.Columns.Count + 4).Value = ""
     Next
    
End Sub
 

Attachments

  • ActiveSheet.png
    ActiveSheet.png
    51.8 KB · Views: 5
  • Prev Month Sheet.png
    Prev Month Sheet.png
    48.3 KB · Views: 5

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

EXCEL MAX

Well-known Member
Joined
Nov 11, 2020
Messages
508
Office Version
  1. 2016
Platform
  1. Windows
Hello Vincent 88,
let's suppose that cells in the range "A1:AL1" are formated as dates.
The code do not using the sheet name to find the last month, but a calculation.
Hope this is a little bit closer to resolving your problem...
VBA Code:
Sub LastMonthData17()
   
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range
    Dim c As Range, f As Range
    Dim lastrow1 As Long
    Dim lastrow2 As Long
    Dim rng1Col As Range, rng2Col As Range

    Set ws1 = Sheets("202108")   'Need to Change to previous month of ActiveSheetName
    Set ws2 = ActiveSheet
    lastrow1 = ws1.Range("A" & Rows.Count).End(xlUp).row
    lastrow2 = ws2.Range("A" & Rows.Count).End(xlUp).row
    Set rng1 = ws1.Range("A3:AL" & lastrow1)
    Set rng2 = ws2.Range("A3:G" & lastrow2)
    Set rng1Col = ws1.Range("A3:AL" & lastrow1).Columns(1)      'Column A in Sheet of previous month
    Set rng2Col = ws2.Range("A3:G" & lastrow1).Columns(1)       'Column A in Activesheet
 
    Dim vLastMonth As Date, vDate, vColumn As Range
'the past month
    vLastMonth = Application.Max(ws1.[A1:AL1]) - 31
'the number of days in the past month
    vDays = DateAdd("m", 1, vLastMonth) - vLastMonth
'create last date in the month
    vDate = DateSerial(Year(vLastMonth), Month(vLastMonth), vDays)
'find this date in the range of the dates in the first row
    Set vColumn = ws1.[A1:AL1].Find(vDate)
    If Not vColumn Is Nothing Then
'copy to the destination
        ws1.Cells(1, vColumn.Column + 2).Offset(0, -6). _
        Resize(lastrow1, 5).Copy ws2.[C1]
    End If
   
End Sub
 

Vincent88

Active Member
Joined
Mar 5, 2021
Messages
337
Office Version
  1. 2019
Platform
  1. Windows
  2. Mobile
Hi EXCEL MAX,
Thank you for your response.
The final code which I need should find the names in column A first then find loop thru C1 to AL1 in previous sheet to find position of the last 5 dates then copy its data (from row 3) to new sheet C3 to G3 of each name in column A.
My code is only able to find those names in Column A but not the position of those 5 days in previous sheet so I need your expertise to combine my code and yours -find the position of the last five days in previous month sheet then copy the data to new sheet.
Please click the below link of my file. When you run module 1 or right click A1, it will create a new sheet of next month. You will told what I am asking for.
My original code is in module 17.

May be there is some misunderstanding thus your code seems not working. And I cannot hardcode the ws1 as "202108" , it should be something like activesheetname -1 when a new month sheet is created.
 

EXCEL MAX

Well-known Member
Joined
Nov 11, 2020
Messages
508
Office Version
  1. 2016
Platform
  1. Windows
Try this procedure...
VBA Code:
Sub LastMonthData17()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range
    Dim c As Range, f As Range
    Dim lastrow1 As Long
    Dim lastrow2 As Long
    Dim rng1Col As Range, rng2Col As Range
    
    ActiveWindow.ScrollColumn = 1
'replace setting ws1 and ws2 line places
    Set ws2 = ActiveSheet
    Set ws1 = Sheets(ws2.Index + 1) 'Need to Change to previous month of ActiveSheetName
    
    lastrow1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    lastrow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    Set rng1 = ws1.Range("A3:AL" & lastrow1)
    Set rng2 = ws2.Range("A3:G" & lastrow2)
    Set rng1Col = ws1.Range("A3:AL" & lastrow1).Columns(1)      'Column A in Sheet of previous month
    Set rng2Col = ws2.Range("A3:G" & lastrow1).Columns(1)       'Column A in Activesheet
             
    Dim vLastDate As Date, vDate, vColumn As Range
'the greatest date
    vLastDate = Application.Max(ws1.[A1:AL1])
'format date for search
    vDate = Format(CStr(vLastDate), "[$-en-US]d-mmm;@")
'find this date in the range of the dates in the first row
    Set vColumn = ws1.Range("A1:AL1").Find(vDate)
    For Each c In rng1Col.Cells
        Set f = rng2Col.Find(c.Value, , xlValues, xlWhole)
'Search the last 5 days of previous month then copy & paste to column C:G in ActiveSheet
        If Not f Is Nothing Then
            f.Offset(, 2).Resize(, f.Columns.Count + 4).Value = _
            c.Offset(, vColumn.Column - 5).Resize(, 5).Value
        End If
    Next c
    ws2.Cells(1, 3).Resize(, 5).Value = _
        ws1.Cells(1, vColumn.Column - 4).Resize(, 5).Value
    'IF NO MATCH, THEN PUT BLANK IN CELLS
    For Each c In rng2Col
        If IsEmpty(c.Value) Then f.Offset(, 2).Resize(, f.Columns.Count + 4).Value = ""
    Next
     
End Sub
 

Vincent88

Active Member
Joined
Mar 5, 2021
Messages
337
Office Version
  1. 2019
Platform
  1. Windows
  2. Mobile

ADVERTISEMENT

Hi EXCEL MAX,
can you change this code vLastDate = Application.Max(ws2.[A1:AL1]) to count the last day of the month from cell H1 since H1 is always the 1st day of that month. The problem is if a month with 30 days, then the last cell AL1 will be 1st day of next month and of month Feb, the date in AL1 will be 3rd of March.
Below code seems not necessary

ws2.Cells(1, 3).Resize(, 5).Value = _
ws1.Cells(1, vColumn.Column - 4).Resize(, 5).Value
 

EXCEL MAX

Well-known Member
Joined
Nov 11, 2020
Messages
508
Office Version
  1. 2016
Platform
  1. Windows
I saw some errors.
Now works much more better.
VBA Code:
Sub LastMonthData17()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range
    Dim c As Range, f As Range
    Dim lastrow1 As Long
    Dim lastrow2 As Long
    Dim rng1Col As Range, rng2Col As Range
    
    ActiveWindow.ScrollColumn = 1
'replace setting ws1 and ws2 line places
    Set ws2 = ActiveSheet
    Set ws1 = Sheets(ws2.Index + 1) 'Need to Change to previous month of ActiveSheetName
    
    lastrow1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    lastrow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    Set rng1 = ws1.Range("A3:AL" & lastrow1)
    Set rng2 = ws2.Range("A3:G" & lastrow2)
    Set rng1Col = ws1.Range("A3:AL" & lastrow1).Columns(1)      'Column A in Sheet of previous month
    Set rng2Col = ws2.Range("A3:G" & lastrow1).Columns(1)       'Column A in Activesheet
             
    Dim vLastDate As Date, vColumn As Range
'the greatest date
    vLastDate = Application.Max(ws1.[H1:AL1])
'find this date in the range of the dates in the first row
    Set vColumn = ws1.Range("H1:AL1").Find(vLastDate, , xlFormulas)
    For Each c In rng1Col.Cells
        Set f = rng2Col.Find(c.Value, , xlValues, xlWhole)
'Search the last 5 days of previous month then copy & paste to column C:G in ActiveSheet
        If Not f Is Nothing Then
            f.Offset(, 2).Resize(, f.Columns.Count + 4).Value = _
            c.Offset(, vColumn.Column - 5).Resize(, 5).Value
        End If
    Next c
    'IF NO MATCH, THEN PUT BLANK IN CELLS
    For Each c In rng2Col
        If IsEmpty(c.Value) Then f.Offset(, 2).Resize(, f.Columns.Count + 4).Value = ""
    Next
    
End Sub
 
Solution

Vincent88

Active Member
Joined
Mar 5, 2021
Messages
337
Office Version
  1. 2019
Platform
  1. Windows
  2. Mobile
Hi EXCEL MAX,
I cannot use vLastDate = Application.Max(ws1.[H1:AL1]) as it cannot find the last date of that month if total days of month is less than 31. With help of others in this forum to get the last date code. I manage to modify to make it works. If you find any where to it more simple, please let me know.
Much apprecicate your advice.

VBA Code:
Sub LastMonthData17()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range
    Dim c As Range, f As Range
    Dim lastrow1 As Long
    Dim lastrow2 As Long
    Dim rng1Col As Range, rng2Col As Range
    
    ActiveWindow.ScrollColumn = 1
    
    Set ws2 = ActiveSheet           'Current month sheet
    Set ws1 = Sheets(ws2.Index + 1) 'Newly month-sheet created
    
    lastrow1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    lastrow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    Set rng1 = ws1.Range("A3:AL" & lastrow1)
    Set rng2 = ws2.Range("A3:AL" & lastrow2)
    Set rng1Col = ws1.Range("A3:AL" & lastrow1).Columns(1)      'Column A in Sheet of previous month
    Set rng2Col = ws2.Range("A3:AL" & lastrow2).Columns(1)      'Column A in Newly created Sheet
            
    Dim vLastDate As Date, vColumn As Range
        'the last date
         vLastDate = CDate(Format(ws1.Name + 1, "0000-00")) - 1
    
        'find this date in the range of the dates in the first row
         Set vColumn1 = ws1.Range("C1:AL1").Find(vLastDate, , xlFormulas)
         Set vColumn2 = ws2.Range("C1:AL1").Find(vLastDate, , xlFormulas)
        
    For Each c In rng1Col.Cells
        Set f = rng2Col.Find(c.Value, , xlValues, xlWhole)
        
        'Search the last 5 days of previous month then copy & paste to column C:G in ActiveSheet
        If Not f Is Nothing Then
           f.Offset(, vColumn2.Column - 5).Resize(, 5).Value = _
           c.Offset(, vColumn1.Column - 5).Resize(, 5).Value
   
       End If
    Next c
    'IF NO MATCH, THEN PUT BLANK IN CELLS
    For Each c In rng2Col
         If IsEmpty(c.Value) Then f.Offset(, vColumn2.Column - 5).Resize(, 5).Value = ""
    Next
    
End Sub
 

EXCEL MAX

Well-known Member
Joined
Nov 11, 2020
Messages
508
Office Version
  1. 2016
Platform
  1. Windows
It was good idea to send a new question to a forum.
I saw that. Phuoc did a great thing.
LastOfMonth = DateAdd("m", 1, CDate(Format(sheetName, "0000-00"))) – 1
is very clever way to convert sheetname string to the first day of the month.
Whatever, I'm glad that you found a solution.:)
 

Forum statistics

Threads
1,147,451
Messages
5,741,202
Members
423,648
Latest member
steel1968

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
Top