Macro to copy/paste based on column date

[Scotty001]

Ok I have 2 sheets on sheet1 cell A1 I will enter date and in B1 a value, A1 and B1 change; on sheet2 on column A are dates(every day of the year) and column B is empty. I would like a macro to search on sheet2 column A for the date I put in sheet1 cell A1 and copy the value from B1 to sheet2 column B next to the according date.
This is what I use atm but if I do it like this I have to write that again and again for every day of the year so I need help to make a code to avoid that.
In this example C1=A1 from sheet2.

Sub test()
**Sheets("Sheet1").Select
If Range("A1") = Range("C1") Then
  If Range("B1").Value > "0" Then
  Range("B1").Copy
  Sheets("Sheet2").Select
  Range("B1").PasteSpecial xlPasteValues
  else
  end if
else
end if
end sub

 

[Luke M]

Does this help give you some guidance?

Sub CopyData()
Dim myDate As Date
Dim myValue As Variant
myDate = Worksheets("Sheet1").Range("A1").Value
myValue = Worksheets("Sheet1").Range("B1").Value

'Note that this will overwrite whatever was already in col B
Worksheets("Sheet2").Range("A:A").Find(myDate).Offset(0, 1).Value = myValue

End Sub

 

[Scotty001]

Does this help give you some guidance?

Sub CopyData()
Dim myDate As Date
Dim myValue As Variant
myDate = Worksheets("Sheet1").Range("A1").Value
myValue = Worksheets("Sheet1").Range("B1").Value

'Note that this will overwrite whatever was already in col B
Worksheets("Sheet2").Range("A:A").Find(myDate).Offset(0, 1).Value = myValue

End Sub

Yes this did the trick so i don't have to write all that over and over again tyvm.

 

[Scotty001]

After I made the code to suite what I've been working on now I have a different file and bit different problem and I have to adjust the code for it.

Sub Test()
Sheets("Sheets").Select
Dim Found As Range, LR As Long
x = Range("A1")
LR = Range("B" & Rows.Count).End(xlUp).Row
Set Found = Columns(1).Find(what:=x)
If Found Is Nothing Then
  MsgBox "Date not found"
Else
  Found.Offset(0, 1).Value = Range("C1")
  Found.Offset(0, 2).Value = Range("C2")
End If
End Sub

This worked fine since I only needed to look for 1 date in all the range but now I have a whole month that I need to look for in that range how can I make the "x" loop trough the whole column of date's I need to find?
If it helps the sheet look like this on column "A" are the dates for the current month and on "B" are the dates for the whole year so I need the x to change to A2.. A3.. A4.. etc until A runs out of info.

Thank you for your patience with me ^_^

 

[PeterB]

Hi Scotty,

Try this (workbook attached).

Sub MatchDates()

Dim ws As Worksheet
Dim rngSearch As Range
Dim rngCell As Range
Dim rngFound As Range
Dim iLastRow As Long
Dim sFind As String

Set ws = Sheets("Sheet1")
iLastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
Set rngSearch = ws.Range("A1:A" & iLastRow)

sFind = Range("A1").Value

For Each rngCell In rngSearch
  'You need to set the search to the DateValue rather than just the string
  Set rngFound = ws.Columns(1).Find(What:=DateValue(sFind), LookIn:=xlFormulas)
  If rngFound Is Nothing Then
    MsgBox "Date not rngFound"
  Else
    rngFound.Offset(0, 1).Value = ws.Range("C1")
    rngFound.Offset(0, 2).Value = ws.Range("C2")
  End If

Next rngCell


'Clean up
Set ws = Nothing
Set rngFound = Nothing
Set rngCell = Nothing
Set rngSearch = Nothing

End Sub

Regards,

Peter

 

[Scotty001]

Hey peter thank you for your reply but it seems I can't adapt that for what I need so I will attach the exact file I need to work with. On that sheet on column's A:C I have what I need to find and on column's G:I is where I search, those dates might even duplicate so I need to find all with those exact info in them. For the ones that it finds exact date I need it to copy cell value from column J to column K on the row it finds the exact match. Thank you again for the support.

 

[Smallman]

Hi Scotty
Can I make a suggestion – ditch this Find method. Since you want to search for multiple criteria use an Advanced filter. Change the set up of your file slightly and add a header, data, evern dummy data should always have a header.

Now use the following.

Option Explicit
 
Sub MatchMulti()
Dim lr As Long
Dim i As Integer
Application.ScreenUpdating = False
    For i = 5 To Range("A" & Rows.Count).End(xlUp).Row
        [A2:C2] = Range("A" & i & ":C" & i).Value
        Range("G4:J200").AdvancedFilter xlFilterInPlace, [A1:C2], Unique:=False
        lr = Range("G" & Rows.Count).End(xlUp).Row
          If lr > 4 Then
            Range("J5", Range("J65536").End(xlUp)).Offset(0, 1).Value = "=RC[-1]"
          End If
    Next
    ActiveSheet.ShowAllData
  [K5:K200].Value = [K5:K200].Value
  Application.ScreenUpdating = True
End Sub

File attached to show workings.

Take care

Smallman

 

[Scotty001]

Yes that works perfect Smallman thank you very much.

 

[Smallman]

No worries Scotty

Let us know if you have any issues.

Take care

Smallman