Forum Discussion

doit_2729's avatar
doit_2729
Copper Contributor
May 29, 2022
Solved

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

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:

 

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 

 

 

 

 

 

 

  • 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

2 Replies

  • 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
    • doit_2729's avatar
      doit_2729
      Copper Contributor
      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,.

Resources