Help Required Amending Some VBA Code

[purceld2]

I have a bit of VBA code which I obtain of this BB and it works fine on the sample Spreadsheet below but I am trying to amended to work on a slightly different SS and also introduce some flexibility to the code.

The code below works fine on this SS

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1	Venue Code	Slot 1	Slot 2	Slot 3	Slot 4	Slot 5	Slot 6	Slot 1	Slot 2	Slot 3	Slot 4	Slot 5	Slot 6	Slot 1	Slot 2	Slot 3	Slot 4	Slot 5	Slot 6	Slot 1	Slot 2
2	10013				514		511				514		511						511
3	10023						511						511						511
4	10024				514		511				514		511						511
5	10030				514		511				514		511						511
6	10031				514		511				514		511						511
7	10033	233	233	233			511	233	233	233			511	233	233	233			511	233	233
8	10036				514		511				514		511						511
9	10044				514		511				514		511						511
10	10056				514		511				514		511						511
11	10057				514		511				514		511						511
12	10066				514		511				514		511						511
13	10070	233	233	233	514			233	233	233	514			233	233	233				233	233
14	10072				514		511				514		511						511
15	10073				514		511				514		511						511
Sheet1

I am trying to amend the code to work on the SS below amending the code to invite the user to enter a date then the code would move along row 1 to find the corresponding date. Then the column that is slot 1 would be the starting point for the VBAcode. It would then summerise the data contained in slot 1 to 6 for the date entered.

Excel Workbook
	A	B	CC	CD	CE	CF	CG	CH	CI	CJ	CK	CL	CM	CN	CO	CP	CQ	CR	CS	CT	CU	CV	CW	CX	CY	CZ
1	Lookup Date	30/08/2010	26/07/2010						02/08/2010						09/08/2010						16/08/2010
2	Venue Code	Count	1	2	3	4	5	6	1	2	3	4	5	6	1	2	3	4	5	6	1	2	3	4	5	6
1213	308504	2			SHELL	708			741	741	736	708	SHELL		741	741	736	708	SHELL		741	741	SHELL	708
1237	347814	2			SHELL	708			741	741	736	708	SHELL		741	741	736	708	SHELL		741	741	SHELL	708
1238	347825	2			SHELL	708			741	741	736	708	SHELL		741	741	736	708	SHELL		741	741	SHELL	708
1246	347912	2			SHELL	708			741	741	736	708	SHELL		741	741	736	708	SHELL		741	741	SHELL	708
1248	347936	2			SHELL	708			741	741	736	708	SHELL		741	741	736	708	SHELL		741	741	SHELL	708
1584	620387	2			SHELL	708			741	741	736	708	SHELL		741	741	736	708	SHELL		741	741	SHELL	708
Venue Availability Checker

Code that needs amending

[face=Courier New]Sub Count_Slot_Items()
Dim LastRow As Long

Application.ScreenUpdating = False

With Sheets("Sheet2")

.Columns("A:L").Clear

For c = 0 To 10 Step 2

Sheets("Sheet1").Columns("B:B").Offset(, c / 2).Copy Destination:=.Range("B1").Offset(, c)

.Columns("B:B").Offset(, c).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("A1").Offset(, c), Unique:=True
.Columns("B:B").Offset(, c).Clear
LastRow = .Range("A" & Rows.Count).Offset(, c).End(xlUp).Row

.Range("B1").Offset(, c).Value = "Count"
If LastRow > 1 Then
.Range("B2").Offset(, c).Formula = "=COUNTIF(Sheet1!" & Columns(2 + c / 2).Address & "," & Range("A2").Offset(, c).Address(0, 0) & ")"
If LastRow > 2 Then
.Range("B2").Offset(, c).AutoFill Destination:=.Range("B2:B" & LastRow).Offset(, c)
End If
.Range("B2:B" & LastRow).Offset(, c).Value = .Range("B2:B" & LastRow).Offset(, c).Value
End If

Next c

' Format cells
Range("A1").Copy
Range("A1", Range("A1").End(xlToRight)).PasteSpecial Paste:=xlPasteFormats
.Select

End With

Application.ScreenUpdating = True

End Sub
[/face]