Match dates Copy Row

Wolfgang17 · Nov 24, 2016

Looking for help with matching two dates from two separate sheets and copying data from matched dates.
I am trying to Match dates between sh1 and sh2. Starting in Column “B” on sheet 1 and matching date in column “A” of sh2. Dates are same format dd-mmm-yy. Once matched, copy corresponding data in columns B:I on sh2 and paste rows of data in sh1 starting in column F.

Match dates sh2 (Range A2:A1060) with sh1 (Range B2:B318)
Copy cell value from Range B2:I2 from sh2 from dates that match, and paste starting in Column F2 of sh1

Any help would be appreciated.

Thanks

[CODESub findAndCopy()

Dim foundCell As Range
Dim strFind As String
Dim fRow, fCol As Integer
Dim sh1, sh2 As Worksheet

'Set sheets
Set sh1 = Sheets("Softener")
Set sh2 = Sheets("Chemical Addition")

'Get find string
strFind = sh1.Range("B2:B318").Value

'Find string in column A of Sheet2
Set foundCell = sh2.Range("A2:A1060").Find(strFind, LookIn:=xlValues)

'If match cell is found
If Not foundCell Is Nothing Then

'Get the row and column
fRow = foundCell.Row
fCol = foundCell.Column

'copy data from Sheet2
'????

'paste in range F2 of Sheet1
sh1.Range("F2:F318").PasteSpecial xlPasteValues

'Clear cache
Application.CutCopyMode = False

'If not found, show message.
Else

Call MsgBox("Not found the match cell!", vbExclamation, "Finding String")

End If

End Sub
][/CODE]

Wolfgang17 · Nov 24, 2016

Code:

Sub findAndCopy()

    Dim foundCell As Range
    Dim strFind As String
    Dim fRow, fCol As Integer
    Dim sh1, sh2 As Worksheet

    'Set sheets
    Set sh1 = Sheets("Softener")
    Set sh2 = Sheets("Chemical Addition")

    'Get find string
    strFind = sh1.Range("B2:B318").Value

    'Find string in column A of Sheet2
    Set foundCell = sh2.Range("A2:A1060").Find(strFind, LookIn:=xlValues)

    'If match cell is found
    If Not foundCell Is Nothing Then

        'Get the row and column
        fRow = foundCell.Row
        fCol = foundCell.Column

        'copy data from Sheet2
        '????
        

        'paste in range F2 of Sheet1
        sh1.Range("F2:F318").PasteSpecial xlPasteValues

        'Clear cache
        Application.CutCopyMode = False

    'If not found, show message.
    Else

        Call MsgBox("Not found the match cell!", vbExclamation, "Finding String")

    End If

End Sub

Match dates Copy Row

Wolfgang17

Board Regular

Excel Facts

Wolfgang17

Board Regular

Similar threads

Forum statistics

Share this page

Match dates Copy Row

Wolfgang17

Board Regular

Excel Facts

Wolfgang17

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock