PDA

View Full Version : Solved: Application-defined or object-defined error



hermann
11-29-2009, 05:32 PM
I'm trying to copy some stuff into another workbook and set conditional formatting. However, I ran into a very confusing run-time error.

I paste the code here and I also attach the excel file. The line causing error is:
Set kohde = Worksheets("Lähdealue").Range(Cells(2, i), Cells(maxRows, i))
If I remove worksheets("Lähdealue") code works but not the way I intended

What is causing the problem? How do I fix this? Thanks in advance!
Option Explicit

Sub luoPivotLahdeAlue()

Dim row, column As Long
Dim rowEnd, columnEnd As Long

' mille sarakkeelle pivotin kenttä kopioidaan
Dim i As Long
i = 1

' alue, johon kelpoisuusehto asetetaan
Dim kohde, ehdot As Range
Dim ehdotstr As String

Dim maxRows As Long
maxRows = 65000

rowEnd = Range("A4").End(xlDown).row

' Käydään läpi kaikki kentät
For row = Range("A4").row To rowEnd

Range("A" & row).Copy Destination:=Worksheets("Lähdealue").Cells(1, i)

column = 1
' set conditional formatting
If Cells(row, column + 1).Value <> "" Then

' selvitetään se sarakkeen numero, jossa viimeinen ehto sijaitsee
While Cells(row, column).Value <> ""
column = column + 1
'MsgBox Cells(row, column).Address
Wend
columnEnd = column - 1

' asetetaan ehtoalue
Set ehdot = Range(Range("B" & row), Cells(row, columnEnd))
ehdotstr = "=" & Range("B" & row).Address & ":" & Cells(row, columnEnd).Address
' This causes an error. If I remove worksheets("Lähdealue") code works but not the way I intend
Set kohde = Worksheets("Lähdealue").Range(Cells(2, i), Cells(maxRows, i))

' asetetaan kelpoisuusehdot valitulle alueelle
With kohde.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=ehdotstr
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Else
Set kohde = Range(Cells(rowEnd + 5, i), Cells(maxRows, i))
kohde.Validation.Delete
End If


i = i + 1
Next row

End Sub

Bob Phillips
11-29-2009, 05:48 PM
Try



Set kohde = Worksheets("Lähdealue").Range(Worksheets("Lähdealue").Cells(2, i), Worksheets("Lähdealue").Cells(maxRows, i))

wpanssi
11-30-2009, 02:44 PM
Subscribing.. I get 1004 errors every now and then and can't figure out why.

hermann
11-30-2009, 02:52 PM
Thanks, it seems to work.