May 29 2022 02:08 PM
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
May 29 2022 02:46 PM
SolutionHere 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
May 31 2022 06:40 PM
May 29 2022 02:46 PM
SolutionHere 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