VB lookup date, then copy and paste

[LROCCO]

Hi All,

I'm looking for some help on creating a macro for the following:

Using cell A1 in Workbook 1 (contains a date in format dd/mm/yy),
match this date with the same date in Column A in Workbook 2. Column
A in Worksheet 2, starts with 31/01/10 in cell A2 and continues to
31/12/20 in cell A3989 (in date order). This end date may increase so
I would like the macro to locate the end of column.

When a match is found, I would like the macro to copy the content in
Workbook 1 Row 1. This row starts at A1 and ends LJ, but again I
would like this to be flexible. This data should be pasted into
Workbook 2, using the associated date match. The copied row of data
should start at column A of Workbook 2.

Thanks in advance

 

[Dave Peterson]

First, those A1 references live in worksheets -- not directly in workbooks.

So...

Option Explicit
Sub testme()
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim res As Variant 'could be an error

'no idea what these are!
Set wks1 = Workbooks("book1.xls").Worksheets("Sheet1")
Set wks2 = Workbooks("book2.xls").Worksheets("Sheet2")

With wks1
'look for a match between A1 and wks2 column A
res = Application.Match(CLng(.Range("a1").Value), _
wks2.Range("A:a"), 0)

If IsNumeric(res) Then
'a match was found!
'why copy A1 if it matched???
.Range("b1:Lj1").Copy _
Destination:=wks2.Cells(res, "B")
Else
MsgBox "No match"
End If
End With
End Sub


Untested, but it did compile.

 

[LROCCO]

First, those A1 references live in worksheets -- not directly in workbooks.

So...

Option Explicit
Sub testme()
     Dim wks1 As Worksheet
     Dim wks2 As Worksheet
     Dim res As Variant 'could be an error

     'no idea what these are!
     Set wks1 = Workbooks("book1.xls").Worksheets("Sheet1")
     Set wks2 = Workbooks("book2.xls").Worksheets("Sheet2")

     With wks1
        'look for a match between A1 and wks2 column A
        res = Application.Match(CLng(.Range("a1").Value), _
                  wks2.Range("A:a"), 0)

        If IsNumeric(res) Then
           'a match was found!
           'why copy A1 if it matched???
           .Range("b1:Lj1").Copy _
              Destination:=wks2.Cells(res, "B")
        Else
           MsgBox "No match"
        End If
     End With
End Sub

Untested, but it did compile.

Thanks Dave...works a treat. How couldI tweak the code to
PasteSpecial value?

 

[Dave Peterson]

This (logical) line:

.Range("b1:Lj1").Copy _
Destination:=wks2.Cells(res, "B")


Becomes two lines:

.Range("b1:Lj1").Copy
wks2.Cells(res, "B").pastespecial paste:=xlpastevalues


(Untested. So watch for typos.)

 

[LROCCO]

This (logical) line:

            .Range("b1:Lj1").Copy _
                Destination:=wks2.Cells(res, "B")

Becomes two lines:

            .Range("b1:Lj1").Copy
            wks2.Cells(res, "B").pastespecial paste:=xlpastevalues

(Untested.  So watch for typos.)

Thanks Dave, works fine