Macro that concatenates two cells, references a Date and then copy pastes value into

Status
Not open for further replies.

rj1600

Banned
Joined
Jan 20, 2021
Messages
9
Reaction score
0
Points
0
Excel Version(s)
Version 2012
Would love some help writing this macro
i tried attaching a file with more explanations within the file if it helps make it clearer. (in yellow highlights & red text)


I have two sheets. One titled 'Money', the second titled 'Data'
In the 'Money' tab, there's a section which currently begins from row 41 where the macro would be populating the data it's pulling. For clarity's sake, i'll refer to this section as the Expense section.

Essentially, the macro is pulling data from the 'Data' tab based on certain criteria (the date). If the criteria is met, it will copy the data of its respective row from the 'Data' tab; will go to the 'Money' tab, look for the last row that contains data in the first portion of the Expense section, creates a new row and pastes values in this new row; making sure not to be pasting over any previous data

written out as steps:

if the concatenation of N & O of 'Data' sheet, viewed as Date format, matches the month of today's date; then copy and paste values of the concatenation into the first available row in column B of 'Money' sheet (beginning from B42 onwards)
then still referencing that same row in 'Data' sheet, copy columns P thru S and paste values into columns C thru F of 'Money' sheet in the same row that was previously referenced.
then still referencing that same row in 'Data' sheet, copy columns T and U and paste values into columns H & I of 'Money' sheet in the same row that was previously referenced.
then still referencing that same row in 'Data' sheet, copy column V and paste values into column G of 'Money' sheet in the same row that was previously referenced



i hope i explained that decently. please let me know if the Excel file isn't any clearer and i'll add more clarity.
 

Attachments

  • online copy.xlsx
    25.8 KB · Views: 21
Hi and welcome
Please,do not crosspost your question on multiple forums without including links here to the other threads on other forums.

Cross-posting is when you post the same question in other forums on the web. The last thing you want to do is waste people's time working on an issue you have already resolved elsewhere. We prefer that you not cross-post at all, but if you do (and it's unlikely to go unnoticed), you MUST provide a link (copy the url from the address bar in your browser) to the cross-post.

Read this to understand why we ask you to do this, and then please edit your first post to include links to any and all cross-posts in any other forums (not just this site).
If you have fewer than 10 posts here, you will not be able to post a link, but you must still tell us where else you have asked the question
As you are new I will add it for you this once https://www.ozgrid.com/forum/index....ate-and-then-copy-pastes-value-i/#post1243461
 
Try this

Code:
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Public Sub GetData()
Dim target As Worksheet
Dim testdate As Date
Dim nextrow As Long
Dim lastrow As Long
Dim i  As Long[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]    Application.ScreenUpdating = False
    
    Set target = Worksheets("Data")
    With target
    
        lastrow = .Cells(.Rows.Count, "N").End(xlUp).Row
    End With
    
    
    With Worksheets("Money")
    
        If .Cells(42, "B").Value = vbNullString Then
        
            nextrow = 42
        ElseIf .Cells(43, "B").Value = vbNullString Then
        
            nextrow = 43
        Else
        
            nextrow = Cells(42, "B").End(xlDown).Row + 1
        End If
        
        For i = 2 To lastrow
        
            testdate = 0
            On Error Resume Next
            testdate = DateSerial(Year(Date), target.Cells(i, "N").Value, target.Cells(i, "O").Value)
            On Error GoTo 0
            
            If testdate = Date Then
            
                .Cells(nextrow, "B").Value = Date
                target.Cells(i, "P").Resize(1, 4).Copy .Cells(nextrow, "C")
                target.Cells(i, "T").Resize(1, 2).Copy .Cells(nextrow, "H")
                target.Cells(i, "V").Copy .Cells(nextrow, "G")
                
                nextrow = nextrow + 1
            End If
        Next i
    End With[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]    Application.ScreenUpdating = True
End Sub
[/FONT]
 
thanks so much for the help Bob.

Just tried running it, getting this error: Run-time error '13' Type mismatch.
when i click Debug, it stops at this point:

If .Cells(42, "B").Value = vbNullString Then


any ideas why? i'm going to do some googling and try to understand what the code is doing
 
Please add code tags around code ( the #button). Thanks

Please confirm you have read and understood post #2
 
yes i understand post 2
 
i didn't see the option to edit my post


are you also able to help with my question or just policing?
 
As an admin, one of my jobs is keeping the forum tidy
 
Just tried running it, getting this error: Run-time error '13' Type mismatch.
when i click Debug, it stops at this point:

If .Cells(42, "B").Value = vbNullString Then


any ideas why? i'm going to do some googling and try to understand what the code is doing

No, I ran it on the workbook you provided and it worked for me.

But, I have just tried it again, and I forgot to mention you need to clear out all of those #N/As in A42:F52.

I also noticed an omission in my code, one unqualified cell reference. this is the corrected version

Code:
Public Sub GetData()
Dim target As Worksheet
Dim testdate As Date
Dim nextrow As Long
Dim lastrow As Long
Dim i  As Long
    Application.ScreenUpdating = False
    
    Set target = Worksheets("Data")
    With target
    
        lastrow = .Cells(.Rows.Count, "N").End(xlUp).Row
    End With
    
    
    With Worksheets("Money")
    
        If .Cells(42, "B").Value = vbNullString Then
        
            nextrow = 42
        ElseIf .Cells(43, "B").Value = vbNullString Then
        
            nextrow = 43
        Else
        
            nextrow = .Cells(42, "B").End(xlDown).Row + 1
        End If
        
        For i = 2 To lastrow
        
            testdate = 0
            On Error Resume Next
            testdate = DateSerial(Year(Date), target.Cells(i, "N").Value, target.Cells(i, "O").Value)
            On Error GoTo 0
            
            If testdate = Date Then
            
                .Cells(nextrow, "B").Value = Date
                target.Cells(i, "P").Resize(1, 4).Copy .Cells(nextrow, "C")
                target.Cells(i, "T").Resize(1, 2).Copy .Cells(nextrow, "H")
                target.Cells(i, "V").Copy .Cells(nextrow, "G")
                
                nextrow = nextrow + 1
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub
 
still isn't producing anything for me.
it runs now, but nothing happens


also, should i replace 'Year' with 'Month' on this line?
# testdate = DateSerial(Year(Date), target.Cells(i, "N").Value, target.Cells(i, "O").Value) #
 
can you upload the file you're working in?
can't figure out why it doesn't work on my side


No, I ran it on the workbook you provided and it worked for me.

But, I have just tried it again, and I forgot to mention you need to clear out all of those #N/As in A42:F52.

I also noticed an omission in my code, one unqualified cell reference. this is the corrected version

Code:
Public Sub GetData()
Dim target As Worksheet
Dim testdate As Date
Dim nextrow As Long
Dim lastrow As Long
Dim i  As Long
    Application.ScreenUpdating = False
    
    Set target = Worksheets("Data")
    With target
    
        lastrow = .Cells(.Rows.Count, "N").End(xlUp).Row
    End With
    
    
    With Worksheets("Money")
    
        If .Cells(42, "B").Value = vbNullString Then
        
            nextrow = 42
        ElseIf .Cells(43, "B").Value = vbNullString Then
        
            nextrow = 43
        Else
        
            nextrow = .Cells(42, "B").End(xlDown).Row + 1
        End If
        
        For i = 2 To lastrow
        
            testdate = 0
            On Error Resume Next
            testdate = DateSerial(Year(Date), target.Cells(i, "N").Value, target.Cells(i, "O").Value)
            On Error GoTo 0
            
            If testdate = Date Then
            
                .Cells(nextrow, "B").Value = Date
                target.Cells(i, "P").Resize(1, 4).Copy .Cells(nextrow, "C")
                target.Cells(i, "T").Resize(1, 2).Copy .Cells(nextrow, "H")
                target.Cells(i, "V").Copy .Cells(nextrow, "G")
                
                nextrow = nextrow + 1
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub
 
To add code tags select the code and click the #button.
You can see the result in Bob's post
It's important so that it can be copied easier maintaining the formatting

And if possible please do not quote entire posts (makes posts hard to read and clutters), use the "Quick Reply" button instead. Thanks
 
still isn't producing anything for me.
it runs now, but nothing happens[/code]

You need to have some data with today's date, that was part of your requirement.


also, should i replace 'Year' with 'Month' on this line?

No.
# testdate = DateSerial(Year(Date), target.Cells(i, "N").Value, target.Cells(i, "O").Value) #
 
can you upload the file you're working in?
can't figure out why it doesn't work on my side

I had to manipulate the source data to force a couple of items for today's date.
 
I had to manipulate the source data to force a couple of items for today's date.


ok, so i take that as a no.

i managed to get this done through formulae.
@pecoflyer, you can delete this thread since it was worthless
 
@pecoflyer, you can delete this thread since it was worthless

That is an incredibly rude comment, I will ensure that I never bother trying to help such an ingrate as yourself again.

I am sure no-one will delete it, it should stand as a testimony to you and your attitude.
 
That is an incredibly rude comment, I will ensure that I never bother trying to help such an ingrate as yourself again.

I am sure no-one will delete it, it should stand as a testimony to you and your attitude.


oh no.

hey "bob"
try treading through the thread and recognizing you weren't much help to begin with.
learn how to answer people's questions instead of just doing whatever you want.

i wasn't anticipating anyone deleting it. i'm fully aware of the psyche of coders
 
@rj1600
Due to your lack of respect towards our members trying to help you for free on their spare time, I am withdrawing your posting privileges for 2 weeks.
I hope that when you post again, your attitude will have changed.
Thread closed
 
Status
Not open for further replies.
Back
Top