Application Defined or Object-defined error

[Pauljj]

I get this error message when my macro reaches this part of the code

With WSO.Range("k1:k5000")

Set i = Range("k1:k5000").Value(366).Count

j = i.Row


End With


I need 'I' to equal the number of times 366 appears as a value between K1 and K5000

Any help would be much appreciated

 

[VoG]

Try

i = WorksheetFunction.CountIf(Range("K1:K5000"), 366)

 

[Pauljj]

I now get a different message that says Object variable or With Block variable not set ?

 

[jim may]

Try:

Sub Foo()
Dim Rng As Range
Dim i As Integer
Set Rng = WSO.Range("k1:k15")
i = WorksheetFunction.CountIf(Rng, 366)
MsgBox "I is equal to " & i
End Sub

 

[VoG]

On which line? Can you post the complete code.

 

[Pauljj]

This is the complete code

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 10/03/2011 by paulhai
'

'
Dim WBO As Workbook 'original workbook
Dim WBN As Workbook 'new workbook
Dim WSO As Worksheet 'original worksheet
Dim WSN As Worksheet 'new worksheet
Dim R As Range
Dim i As Integer
Dim H As Long
Dim j As Long


Application.DisplayAlerts = False

Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Columns("H:I").Select
Range("I1").Activate
Selection.Delete Shift:=xlToLeft
Columns("I:I").Select
Selection.Delete Shift:=xlToLeft
Columns("J:L").Select
Selection.Delete Shift:=xlToLeft
Columns("L:Q").Select
Selection.Delete Shift:=xlToLeft
Range("A2").Select
Range("A1:K5000").Sort Key1:=Range("K2"), Order1:=xlAscending, Key2:=Range _
("F2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Selection.Subtotal GroupBy:=11, Function:=xlCount, TotalList:=Array(11), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=False

Columns("C:C").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit



Set WBO = ActiveWorkbook

Set WSO = ActiveSheet

With WSO.Range("J1:J5000")

Set R = .Find("333 Count", LookIn:=xlValues)
H = R.Row


End With

With WSO.Range("k1:k5000")

Set i = .Find(333, LookIn:=xlValues)
j = i.Row


End With

Set WBN = Workbooks.Add(template:=xlWBATWorksheet)
Set WSN = WBN.Worksheets(1)

WSO.Range("a1:k1").Copy Destination:=WSN.Cells(1, 1)



WSO.Range(WSO.Cells(H, 1), WSO.Cells(j, 11)).Copy Destination:=WSN.Cells(2, 1)


ans = InputBox("What week number are you saving this to", "Hinterland")

fn = "Week " & ans & ".xls"
fp = "\\TFCLUSTER-VOL1\VOL1\DEPART\stats\HINTERLAND\Hinterland\2011-12\" & fn

WBN.SaveAs Filename:=fp
WBN.Close savechanges:=False


With WSO.Range("J1:J5000")

Set R = .Find("366 Count", LookIn:=xlValues)
H = R.Row


End With

'With WSO.Range("k1:k5000")

i = WorksheetFunction.CountIf(Range("K1:K5000"), 366) + H

j = i.Row


'End With

Set WBN = Workbooks.Add(template:=xlWBATWorksheet)
Set WSN = WBN.Worksheets(1)

WSO.Range("a1:k1").Copy Destination:=WSN.Cells(1, 1)



WSO.Range(WSO.Cells(H, 1), WSO.Cells(j, 11)).Copy Destination:=WSN.Cells(2, 1)



fn = "Week " & ans & ".xls"
fp = "\\TFCLUSTER-VOL1\VOL1\DEPART\stats\HINTERLAND\Bloomfield\2011-12\" & fn

WBN.SaveAs Filename:=fp
WBN.Close savechanges:=False


Application.DisplayAlerts = True


End Sub

 

[jim may]

Sorry, I changed your range to K1:K15 -- Below shoud work for you

Sub Foo()
Dim Rng As Range
Dim i As Integer
Set Rng = WSO.Range("k1:k5000")
i = WorksheetFunction.CountIf(Rng, 366)
MsgBox "I is equal to " & i
End Sub

 

[VoG]

i is a number - it doesn't have a Row property. You don't seem to be doing anything with j anyway.

 

[Pauljj]

Perfect, thank you very much to you both for replying and helping me out Much appreciated