Excel 365 Compare Date & Copy Cell Data for Data Base

[bz61]

Hello, I'm not a proficient at Excel VBA programming & in need of assistance with the following issue: I have an excel workbook with multiple sheets for planning and building a data base. Attached is one of the sheets that extracts data from one of the other sheets. The upper left range of cells tracks the data live, so I'm unable to use an excel program to transfer the data to the right-side columns and save it. I've attached a VBA program that I found on this site and attempted to modify without much success. It will only copy 3 of the cells after that I get errors if I try to add more lines of code. I need to have the data on the left side under the "AW ENG COUNT" column to be transferred over to the corresponding columns and date on the right side. I'm using the "Today ()" function on the left side "Date" column and Excel auto populate date function on the right-side column. I will be putting the code into the Private Sub Workbook_Open & Close, so when Planners open or close this Workbook, the data will be updated to the last entry for that day and be repeated daily. Thank you in advance.

Private Sub Workbook_Close()

Dim Cl As range
    Dim Dic As Object
    
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Graph Data")
        For Each Cl In .range("d5", .range("d" & Rows.Count).End(xlUp))
            Dic(Cl.Value) = Cl.Offset(1, -1).Value
        Next Cl
    End With
    With Sheets("Graph Data")
        For Each Cl In .range("ba5", .range("ba" & Rows.Count).End(xlUp))
            If Dic.exists(Cl.Value) Then Cl.Offset(, -4).Value = Dic(Cl.Value)
        Next Cl
    End With
    
End Sub

 

[bz61]

The title of this posting can lead one to believe that this sort of problem has already been resolved, but unfortunately the postings I've looked at or that have been recommended don't discuss it. I'm looking to have a single cell with date to be compared to a range of date cells. Then the cells to the left of the single cell in multiple rows will be copied and pasted in the same row next to the matched date. Everything I've found deals with range to range, scripting dictionary, delete or paste ranges.

 

[skillilea]

Don' t you just want to copy the range to the next row?

Sub CopyRangeToLastRow()
    Dim lR As Long
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Sheet1") '  your sheet name
    lR = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row ' not sure what your column is
   
    With ws
        .Cells("H", lR).Value = .Cells("D5").Value  ' fix your columns
        .Cells("I", lR).Value = .Cells("D6").Value
        .Cells("J", lR).Value = .Cells("D7").Value
        .Cells("K", lR).Value = .Cells("D8").Value
        .Cells("L", lR).Value = Date
   End With

End Sub

 

[bz61]

Don' t you just want to copy the range to the next row?

Sub CopyRangeToLastRow()
    Dim lR As Long
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Sheet1") '  your sheet name
    lR = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row ' not sure what your column is
  
    With ws
        .Cells("H", lR).Value = .Cells("D5").Value  ' fix your columns
        .Cells("I", lR).Value = .Cells("D6").Value
        .Cells("J", lR).Value = .Cells("D7").Value
        .Cells("K", lR).Value = .Cells("D8").Value
        .Cells("L", lR).Value = Date
   End With

End Sub

Yes, you are correct, but the I need it to automatically go to the current date. I'm building a data base for a line graph.

 

[skillilea]

I can't see your column headers in the picture. Can you install the XL2BB plug in?

What do you need to go to the current date?

 

[bz61]

Don' t you just want to copy the range to the next row?

Sub CopyRangeToLastRow()
    Dim lR As Long
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Sheet1") '  your sheet name
    lR = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row ' not sure what your column is
  
    With ws
        .Cells("H", lR).Value = .Cells("D5").Value  ' fix your columns
        .Cells("I", lR).Value = .Cells("D6").Value
        .Cells("J", lR).Value = .Cells("D7").Value
        .Cells("K", lR).Value = .Cells("D8").Value
        .Cells("L", lR).Value = Date
   End With

End Sub

Sorry, I've attached a pic of the data sheet with columns showing. I've tried different ways of copying the data but the issue has always been the date alignment. I'm all thumbs when it comes to the VBA coding. Thanks for responding.

 

[skillilea]

1. Delete your data in BD
2. Add the below into a module, right click modules in the VB Editor pas the below in
3. Create shape on your worksheet. right click, assign macro, pick the below name
4. Now start entering the data and click the shape/button

Sub CopyRangeToLastRow()
    Dim lR As Long
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Sheet1") '  your sheet name
    lR = ws.Cells(ws.Rows.Count, "BD").End(xlUp).Row
  
    With ws
        .Cells("AY", lR).Value = .Cells("C5").Value
        .Cells("AZ", lR).Value = .Cells("C6").Value
        .Cells("BA", lR).Value = .Cells("C7").Value
        .Cells("BB", lR).Value = .Cells("C8").Value
        .Cells("BC", lR).Value = .Cells("C9").Value
        .Cells("BD", lR).Value = Date
   End With

End Sub

 

[bz61]

1. Delete your data in BD
2. Add the below into a module, right click modules in the VB Editor pas the below in
3. Create shape on your worksheet. right click, assign macro, pick the below name
4. Now start entering the data and click the shape/button

Sub CopyRangeToLastRow()
    Dim lR As Long
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Sheet1") '  your sheet name
    lR = ws.Cells(ws.Rows.Count, "BD").End(xlUp).Row
 
    With ws
        .Cells("AY", lR).Value = .Cells("C5").Value
        .Cells("AZ", lR).Value = .Cells("C6").Value
        .Cells("BA", lR).Value = .Cells("C7").Value
        .Cells("BB", lR).Value = .Cells("C8").Value
        .Cells("BC", lR).Value = .Cells("C9").Value
        .Cells("BD", lR).Value = Date
   End With

End Sub

Thank you. I do appreciate your assistance. I have 5 sheets in this workbook with multiple Active X buttons on them I was hoping to spare the Planners from having to click another button... : ) My thought process was to have this code put into the "Private Sub Workbook_Open / Close", so when the workbook is opened or closed the update would automatically be done. Hence the driving force behind the matching dates .

 

[skillilea]

Yeah, I don't know your workflow. But that code will populate the next row.
If it's not changed and you put it on either of the open/close events. It will just keep adding the same rows.

If you want to make the date in column D change just make it a formula

=Today()

 

[bz61]

Yeah, I don't know your workflow. But that code will populate the next row.
If it's not changed and you put it on either of the open/close events. It will just keep adding the same rows.

If you want to make the date in column D change just make it a formula

=Today()

Yes, the unfortunate part is that if I paste this into the Open / Close action any time one of the Planners opens the Workbook in the same day, it will add another row with the same date. This will cause issues with the line graph data base and I end right back to where I started; needing a column with prepopulated dates to manage the data. Thank you for all of your effort.