Forum Discussion
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
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
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_2729Copper ContributorHi 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,.