Help Required Amending Some VBA Code

purceld2

Well-known Member
Joined
Aug 18, 2005
Messages
581
Office Version
  1. 2013
Platform
  1. Windows
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
ABCDEFGHIJKLMNOPQRSTU
1Venue CodeSlot 1Slot 2Slot 3Slot 4Slot 5Slot 6Slot 1Slot 2Slot 3Slot 4Slot 5Slot 6Slot 1Slot 2Slot 3Slot 4Slot 5Slot 6Slot 1Slot 2
210013514511514511511
310023511511511
410024514511514511511
510030514511514511511
610031514511514511511
710033233233233511233233233511233233233511233233
810036514511514511511
910044514511514511511
1010056514511514511511
1110057514511514511511
1210066514511514511511
1310070233233233514233233233514233233233233233
1410072514511514511511
1510073514511514511511
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
ABCCCDCECFCGCHCICJCKCLCMCNCOCPCQCRCSCTCUCVCWCXCYCZ
1Lookup Date30/08/201026/07/201002/08/201009/08/201016/08/2010
2Venue CodeCount123456123456123456123456
12133085042SHELL708741741736708SHELL741741736708SHELL741741SHELL708
12373478142SHELL708741741736708SHELL741741736708SHELL741741SHELL708
12383478252SHELL708741741736708SHELL741741736708SHELL741741SHELL708
12463479122SHELL708741741736708SHELL741741736708SHELL741741SHELL708
12483479362SHELL708741741736708SHELL741741736708SHELL741741SHELL708
15846203872SHELL708741741736708SHELL741741736708SHELL741741SHELL708
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]
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,168,112
Messages
5,857,450
Members
431,880
Latest member
kar2rost

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