简体   繁体   中英

In VBA, how do i create a code where it matches dates from 2 sheets and paste data in to that matched date as values? Can't use vlookup for this

So I have 2 sheets on Excel, Calculator and Results Sheets.

On the calculator sheet, Cell A1 has the current date. On the results sheet, Cells A2:Infinity have dates increasing by day.

I am trying to write a program where IF Cells A1 from Calculator sheet are equal to cells A2:Infinity from the Results Sheet, it will copy paste the data cells range C2:C7 from the calculator sheet to the matched date on the results sheet as Transposed Values to the cell range (B:G)

VLOOKUP wont work as the previous data would be gone because of a change of dates.

Results Sheet

Calculator Sheet

Any help would be appreciated!

you can try this code:

Option Explicit

Sub main()
    Dim f As Range, calculatorData As Range
    Dim dateStrng As String

    With Worksheets("Calculator") '<--| reference "Calculator" worksheet
        Set calculatorData = .Range("C2:C7") '<--| set its range with data to be copied
        dateStrng = .Range("A1").value '<-- retrieve the date to be searched
    End With

    With Worksheets("Results") '<--| reference "Results" worksheet
        Set f = .Range("A2", .Range("A2").End(xlDown)).Find(what:=dateStrng, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) '<-- look for searched data in its column "A" cells from row 2 down to last contiguous non empty cell
    End With

    If Not f Is Nothing Then f.Offset(, 1).Resize(, 6).value = Application.Transpose(calculatorData.value) '<--| if date is found then copy relevant values from "Calculator" next to it
End Sub

edit:

should those dates in excel worksheets be not String values but actual Date ones, then just change:

dateStrng = .Range("A1").value '<-- retrieve the date to be searched

into:

dateStrng = WorksheetFunction.Text(.Range("A1").value, "[$-409]mmmm,dd-yyyy;@") '<-- retrieve the date to be searched in the proper language (e.g.: 409 = English)

you can find all language codes here

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM