Macro copy and paste based on condition

[ferr]

I need a macro that does the following.

- if there is a value in A3:E3, it copies and pastes to the corresponding cell in table 1 based on the date in A2:E2 and the corresponding date in E9:E11

in this example, copy and paste from C3 to D11=4,000,000 (August) and E3 to D13=4,000,000 (October)

However, with a condition that if the value under header 'B' is < the value in row 3, it pastes in the next table where the value is => than the value in row 3.

So, in this case, copy and paste from C3 to D11, but since all the October dates under header 'B' are less than E3, it will then paste in X9

 

[Zot]

See if this works to your requirement

Sub Test()

Dim n As Long
Dim ArryCol() As String
Dim cell As Range, rngData As Range, rngFind As Range, rngSearch As Range
Dim ws As Worksheet

Set ws = ActiveWorkbook.Sheets("Sheet1")                         ' Assuming sheet name is Sheet1
Set rngData = ws.Range("A2", "E2")

ArryCol = Split("E,J,O,T,Y", ",")                                            ' Define date column in tables

For Each cell In rngData
    If Not cell.Offset(1) = 0 Then
        For n = 0 To 4
            Set rngSearch = ws.Range(ArryCol(n) & "9", ArryCol(n) & "19")
            Set rngFind = rngSearch.Find(Month(cell))
            If Not rngFind Is Nothing Then
                If cell.Offset(1) <= rngFind.Offset(, -2) Then
                    rngFind.Offset(, -1) = cell.Offset(1)
                    Exit For
                End If
            End If
        Next
    End If
Next

End Sub

 

[ferr]

See if this works to your requirement

Sub Test()

Dim n As Long
Dim ArryCol() As String
Dim cell As Range, rngData As Range, rngFind As Range, rngSearch As Range
Dim ws As Worksheet

Set ws = ActiveWorkbook.Sheets("Sheet1")                         ' Assuming sheet name is Sheet1
Set rngData = ws.Range("A2", "E2")

ArryCol = Split("E,J,O,T,Y", ",")                                            ' Define date column in tables

For Each cell In rngData
    If Not cell.Offset(1) = 0 Then
        For n = 0 To 4
            Set rngSearch = ws.Range(ArryCol(n) & "9", ArryCol(n) & "19")
            Set rngFind = rngSearch.Find(Month(cell))
            If Not rngFind Is Nothing Then
                If cell.Offset(1) <= rngFind.Offset(, -2) Then
                    rngFind.Offset(, -1) = cell.Offset(1)
                    Exit For
                End If
            End If
        Next
    End If
Next

End Sub

Perfect. Thank you.

 

[ferr]

Any idea why nothing is being populated in N9 for August?

 

[Zot]

Any idea why nothing is being populated in N9 for August?

Sorry. I was on leave Friday. Working with Date is always tricky for me

It seem like the use of Find cause the problem. I don't know how to set Find to look for month value. So, it probably just look for something else. It is much easier to just use For loop. Here is my amended code

Sub Test()

Dim nRow As Long, nCol As Long
Dim ArryCol() As String
Dim cell As Range, rngData As Range, rngFind As Range, rngSearch As Range
Dim ws As Worksheet

Set ws = ActiveWorkbook.Sheets("Sheet1")                         ' Assuming sheet name is Sheet1
Set rngData = ws.Range("A2", "E2")

ArryCol = Split("E,J,O,T,Y", ",")                                            ' Define date column in tables

For Each cell In rngData
    If Not cell.Offset(1) = 0 Then
        For nCol = 0 To 4
            For nRow = 9 To 19
                If Month(ws.Range(ArryCol(nCol) & nRow)) = Month(cell.Text) Then
                    If cell.Offset(1) <= ws.Range(ArryCol(nCol) & nRow).Offset(, -2) Then
                        ws.Range(ArryCol(nCol) & nRow).Offset(, -1) = cell.Offset(1)
                        Exit For
                    End If
                End If
            Next
        Next
    End If
Next

End Sub