Marking Bank Holidays on a calendar - code

asylum

Board Regular
Joined
Dec 2, 2003
Messages
243
Hello,

I have a Sheet which is an automated calendar (called ‘Calendar’) which looks like this:

01/01/2012 Sunday 1 St. Godric
02/01/2012 Monday 2 St.Lawrence
03/01/2012 Tuesday 3 Lord Worsley


On another Sheet called BH I have a list of bank holidays which looks like this:

New Years Day Good Friday Easter Monday May Day
01/01/2000 21/04/2000 24/04/2000 01/05/2000
01/01/2001 13/04/2001 16/04/2001 07/05/2001
01/01/2002 29/03/2002 01/04/2002 06/05/2002
01/01/2003 18/04/2003 21/04/2003 05/05/2003


What I am trying to do is put together a bit of code that will run through column A in the Calendar sheet and look up each date
In the range (call it A1 to D5) on the BH sheet. If it finds a match then I want it to copy the name at the head of the column in the range and
Paste it in front of the text in column 4 on the Calendar sheet, to produce:

01/01/2012 Sunday 1 New Years Day, St. Godric
02/01/2012 Monday 2 St.Lawrence
03/01/2012 Tuesday 3 Lord Worsley

Seems easy enough, but I’m a little stumped, I can record something that’s close to it and manipulate it from there like I normally do with Macros\VB, any help appreciated,

Thanks

Andy
 

Some videos you may like

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

asylum

Board Regular
Joined
Dec 2, 2003
Messages
243
so far I have this, just need to make code for the rem'd bits!

any thoughts?

Sub ADDBH()

Dim calrng As Range
Dim BHrng As Range
Dim BH As String

Set calrng = Sheets("calander").Range("A1:A" & (ActiveSheet.UsedRange.Rows.Count))
Set BHrng = Sheets("BH").Range("A1:M41")

For Each c In calrng
'lookup value in BHrng
'if found in bhrng then lookup column title and set BH equal to it
'add it infront of text in cell 3 spaces to right of c
Next c
End Sub
 

asylum

Board Regular
Joined
Dec 2, 2003
Messages
243
ok, trying to attack this logically I'm trying to write it in stages.... so far this wont work... why?

Sub ADDBH()

Dim calrng As Range
Dim cell As Range
Dim BHrng As Range
Dim BH As Variant
Dim finddt As Variant

Set calrng = Sheets("calendar").Range("A1:A" & (ActiveSheet.UsedRange.Rows.Count))
Set BHrng = Sheets("BH").Range("A1:M" & (ActiveSheet.UsedRange.Rows.Count))

For Each cell In calrng
finddt = cell.Value
If Application.Match(finddt, BHrng, 2, False) <> "" Then
BH = Application.Match(cell.Value, BHrng, 0)
'lookup value in BHrng
'if found in bhrng then lookup column title and set BH equal to it
'add it infront of text in cell 3 spaces to right of c
End If
MsgBox (BH)
Next cell
End Sub
 

AD_Taylor

Well-known Member
Joined
May 19, 2011
Messages
687
Give this a go, bearing in mind it is tested but only on a small data set.

Code:
Option Explicit

Sub AddBH()

Dim wsCal As Worksheet, rngCal As Range
Dim wsBH As Worksheet, rngBH As Range

Dim currCell As Range, currDate As Date
Dim foundCol As Long, foundDate As String
Dim outputStr As String
foundCol = 0

Set wsCal = ActiveWorkbook.Worksheets("Calendar")
Set wsBH = ActiveWorkbook.Worksheets("BH")

With wsCal
    Set rngCal = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
Set rngBH = wsBH.UsedRange

For Each currCell In rngCal.Cells

    currDate = currCell.Value
    
    On Error GoTo errHandler:
    foundCol = rngBH.Find(CDate(currDate), After:=wsBH.Range("A1"), LookIn:=xlValues, LookAt:=xlWhole).Column
    
resumeLbl:

    On Error GoTo 0
    
    If foundCol > 0 Then
    
        foundDate = wsBH.Cells(1, foundCol)
        outputStr = wsCal.Cells(currCell.Row, 4).Value
        
        outputStr = foundDate & ", " & outputStr
        
        wsCal.Cells(currCell.Row, 4).Value = outputStr
    
    End If

Next currCell

Exit Sub

errHandler:

foundCol = 0

Resume resumeLbl:

End Sub
This assumes that you don't want to run it once, add some more dates, then run it again.
If you do this the code will obviously produce duplicate holidays as there is no check to see if it has already marked a bank holiday.

It also assumes the names of the bank holidays are in row 1 on the 'BH' sheet.

Hope this helps!
 

asylum

Board Regular
Joined
Dec 2, 2003
Messages
243
HI , Many Many tahnks for this you are a genuis! - I have been wrangling for a day now! I can manipulate this a little more to get exactly what I need, but as you say it does do the job.

Many thanks Again,

Andy
 

Watch MrExcel Video

Forum statistics

Threads
1,123,316
Messages
5,600,910
Members
414,415
Latest member
joshuaba

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