SOLVED

Copy and paste row data based on cell value with date criteria

Copper Contributor

I have the situation where i would like to copy data based on cell value in Column 1 where the row data should be copy row 13 to the below log for the respectively date to track our ripening log. 

 

Currently we are copying data based on the date reference in column 2 however, we have made some changes in our ripening strategy so, as result if we have 2 rooms at different ripening process then the code is not copy and past data to appropriate row.

 

What would be find out come?

- We would like to copy data based on column 1 "4A" to the row for the respectively date in column 2 when click on button "Copy Today's data (4A)" and same like for "Copy  today's data (4B)" to copy data where is says 4B:

 

Screenshot:

doit_2729_0-1653857996777.png

 

code:

Private Sub CommandButton1_Click()
Dim Rg As Range
Set Rg = Me.UsedRange.Columns(2).Find(Application.Text(Date, [B13].NumberFormat), [B15], xlValues)
If Rg Is Nothing Then MsgBox "Today's Date Not Found. Please check the 'Date Received'" Else Rg(1, 2).Resize(1, 13).Value2 = [C13:M13].Value2: Set Rg = Nothing
' Set Rg = Me.UsedRange.Columns(2).Find(Application.Text(Date, [B12].NumberFormat), [B14], xlValues)
' If Rg Is Nothing Then Beep Else Rg(1, 2).Resize(, 13).Value2 = [C12:M13].Value2: Set Rg = Nothing
' Set Rg = Me.UsedRange.Columns(2).Find(Application.Text(Date, [B13].NumberFormat), [B14], xlValues)
' If Rg Is Nothing Then Beep Else Rg(2, 2).Resize(, 13).Value2 = [C13:M13].Value2: Set Rg = Nothing
End Sub

Private Sub CommandButton2_Click()

Dim Rg As Range
Set Rg = Me.UsedRange.Columns(2).Find(Application.Text(Date, [B14].NumberFormat), [B16], xlValues)
If Rg Is Nothing Then MsgBox "Today's Date Not Found. Please check the 'Date Received'" Else Rg(1, 2).Resize(1, 13).Value2 = [C14:M14].Value2: Set Rg = Nothing
' Set Rg = Me.UsedRange.Columns(2).Find(Application.Text(Date, [B12].NumberFormat), [B14], xlValues)
' If Rg Is Nothing Then Beep Else Rg(1, 2).Resize(, 13).Value2 = [C12:M13].Value2: Set Rg = Nothing
' Set Rg = Me.UsedRange.Columns(2).Find(Application.Text(Date, [B13].NumberFormat), [B14], xlValues)
' If Rg Is Nothing Then Beep Else Rg(2, 2).Resize(, 13).Value2 = [C13:M13].Value2: Set Rg = Nothing

End Sub

 

Sample file attached.

 

PS: Apologies for any inconveniences to understand as i am not technical person to express the situation. However, i would be highly obliged if some one can help me.

 

Thanking you 

 

 

 

 

 

 

2 Replies
best response confirmed by doit_2729 (Copper Contributor)
Solution

@doit_2729 

Here you go:

Private Sub CommandButton1_Click()
    Dim r As Long
    On Error Resume Next
    r = Evaluate("MATCH(1,(A16:A1000=""4A"")*(B16:B1000=TODAY()),0)")
    On Error GoTo 0
    If r = 0 Then
        MsgBox "Combination of Room 4A and today's date not found"
    Else
        Range("C" & r + 15).Resize(1, 13).Value = Range("C13").Resize(1, 13).Value
    End If
End Sub

Private Sub CommandButton2_Click()
    Dim r As Long
    On Error Resume Next
    r = Evaluate("MATCH(1,(A16:A1000=""4B"")*(B16:B1000=TODAY()),0)")
    On Error GoTo 0
    If r = 0 Then
        MsgBox "Combination of Room 4B and today's date not found"
    Else
        Range("C" & r + 15).Resize(1, 13).Value = Range("C14").Resize(1, 13).Value
    End If
End Sub
Hi Hans,
You are life saver for me!
It working fine for me.
This is great help to me.

Thanks a lot.

Much appreciated for the you time.
God bless you,.

1 best response

Accepted Solutions
best response confirmed by doit_2729 (Copper Contributor)
Solution

@doit_2729 

Here you go:

Private Sub CommandButton1_Click()
    Dim r As Long
    On Error Resume Next
    r = Evaluate("MATCH(1,(A16:A1000=""4A"")*(B16:B1000=TODAY()),0)")
    On Error GoTo 0
    If r = 0 Then
        MsgBox "Combination of Room 4A and today's date not found"
    Else
        Range("C" & r + 15).Resize(1, 13).Value = Range("C13").Resize(1, 13).Value
    End If
End Sub

Private Sub CommandButton2_Click()
    Dim r As Long
    On Error Resume Next
    r = Evaluate("MATCH(1,(A16:A1000=""4B"")*(B16:B1000=TODAY()),0)")
    On Error GoTo 0
    If r = 0 Then
        MsgBox "Combination of Room 4B and today's date not found"
    Else
        Range("C" & r + 15).Resize(1, 13).Value = Range("C14").Resize(1, 13).Value
    End If
End Sub

View solution in original post