VBA to take a date from a cell on sheet2 and find that date in column A on sheet1

danbates

Active Member
Joined
Oct 8, 2017
Messages
357
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I have a range of cells on Sheet2 Q1:Q12.
They have the third Sunday of each month and they are found with a formula.

On Sheet1 I have column A with all the dates of the year.
Each date is 2 cells merged because in column B I have the colour of which shift will be at work. On either Days or Nights.

I would like a code that can look at cell Q1 on Sheet2 and then find that date on Sheet1.
Then I would like it to copy the night shift colour and paste it to A1 on Sheet2.
Then it to carry on and do the same for the rest of the range on Sheet2. Q1:Q12.

I've added an image so you can see what I mean with regards to how Sheet1 looks.

Any help would be much appreciated.

Thanks

Dan
 

Attachments

  • Capture.JPG
    Capture.JPG
    27.7 KB · Views: 3

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

danbates

Active Member
Joined
Oct 8, 2017
Messages
357
Office Version
  1. 2016
Platform
  1. Windows
I found this code online. I have added the last 8 lines of code which makes the code do exactly what I wanted for 1 part of my original question.

VBA Code:
Sub JAN()

'declare variables
Dim ws As Worksheet
Dim SelectCells As Range
Dim xcell As Object
Dim Rng As Range
Set ws = Worksheets("Sheet1")
Set Rng = ws.Range("A1:A730")
'check each cell in a specific range if the criteria is matching
For Each xcell In Rng
If xcell.Value = Worksheets("Sheet2").Range("Q1") Then
If SelectCells Is Nothing Then
Set SelectCells = Range(xcell.Address)
Else
Set SelectCells = Union(SelectCells, Range(xcell.Address))
End If
End If

Next

SelectCells.Select
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(1, 0).Select

Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
Sheets("Sheet1").Select
End Sub

Please could someone help me alter the code so it does the same for the following:
Q2 copy to A2
Q3 to A3 and so on to
Q12 to A12.

Thanks

Dan
 

Watch MrExcel Video

Forum statistics

Threads
1,128,138
Messages
5,628,919
Members
416,353
Latest member
Nenza

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top