Marking Bank Holidays on a calendar - code

[asylum]

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

 

[asylum]

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]

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]

Give this a go, bearing in mind it is tested but only on a small data set.

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]

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