Hello everyone

The message in the subjectline is displayed when running the code below:

Option Explicit
Sub FindWeek()
Dim DateCell As Range
Dim Rownr As Integer
Dim ColumnDep As Byte
Dim ShiftDown As Byte
Dim i As Byte

Dim Dsd As String
Dim Msd As String
Dim Ysd As String
Set DateCell = Range("SearchDate")
If Range("Dsd").Value < 10 Then
Dsd = "0" & Range("Dsd").Value
Else:
Dsd = Range("Dsd").Value
End If
If Range("Msd").Value < 10 Then
Msd = "0" & Range("Msd").Value
Else:
Msd = Range("Msd").Value
End If

Ysd = Range("Ysd").Value

DateCell = Dsd & "-" & Msd & "-" & Ysd

Sheets("TotaalTabel").Select

Cells.Find(What:=DateCell.Value, After:=ActiveCell, LookIn:=xlFormulas,
_
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate

Rownr = ActiveCell.Row
ColumnDep = 7
ShiftDown = 3

For i = 1 To 16
Range(Range("SearchDate").Offset(ShiftDown, 0), Range("SearchDate").
_
Offset(ShiftDown, 6)).Copy
Cells(Rownr, ColumnDep).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ShiftDown = ShiftDown + 1
ColumnDep = ColumnDep + 1
Next i

End Sub

You need a Set statement when working with Find. Find returns a range object

Dim X as Rang
Set X = Cells.Find......

----- Peter wrote: ----

Hello everyon

The message in the subjectline is displayed when running the code below

Option Explici
Sub FindWeek(
Dim DateCell As Rang
Dim Rownr As Intege
Dim ColumnDep As Byt
Dim ShiftDown As Byt
Dim i As Byt

Dim Dsd As Strin
Dim Msd As Strin
Dim Ysd As Strin
Set DateCell = Range("SearchDate"
If Range("Dsd").Value < 10 The
Dsd = "0" & Range("Dsd").Valu
Else
Dsd = Range("Dsd").Valu
End I
If Range("Msd").Value < 10 The
Msd = "0" & Range("Msd").Valu
Else
Msd = Range("Msd").Valu
End I

Ysd = Range("Ysd").Valu

DateCell = Dsd & "-" & Msd & "-" & Ys

Sheets("TotaalTabel").Selec

Cells.Find(What:=DateCell.Value, After:=ActiveCell, LookIn:=xlFormulas

LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False).Activat

Rownr = ActiveCell.Ro
ColumnDep =
ShiftDown =

For i = 1 To 1
Range(Range("SearchDate").Offset(ShiftDown, 0), Range("SearchDate")

Offset(ShiftDown, 6)).Cop
Cells(Rownr, ColumnDep).PasteSpecial Paste:=xlPasteValues
Operation:=xlNone, SkipBlanks
:=False, Transpose:=Tru
ShiftDown = ShiftDown +
ColumnDep = ColumnDep +
Next

End Su

this line:
Cells.Find(What:=DateCell.Value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate

blows up real good if you can't find that value. Since you're trying to
activate a cell that doesn't exist.

I think most people would use something like this general example:

dim FoundCell as Range
.....
set foundcell = cells.find(------)

if foundcell is nothing then
'what happens in this case?
else
'do your stuff.
end if



Peter wrote:

Hello everyone

The message in the subjectline is displayed when running the code below:

Option Explicit
Sub FindWeek()
Dim DateCell As Range
Dim Rownr As Integer
Dim ColumnDep As Byte
Dim ShiftDown As Byte
Dim i As Byte

Dim Dsd As String
Dim Msd As String
Dim Ysd As String
Set DateCell = Range("SearchDate")
If Range("Dsd").Value < 10 Then
Dsd = "0" & Range("Dsd").Value
Else:
Dsd = Range("Dsd").Value
End If
If Range("Msd").Value < 10 Then
Msd = "0" & Range("Msd").Value
Else:
Msd = Range("Msd").Value
End If

Ysd = Range("Ysd").Value

DateCell = Dsd & "-" & Msd & "-" & Ysd

Sheets("TotaalTabel").Select

Cells.Find(What:=DateCell.Value, After:=ActiveCell, LookIn:=xlFormulas,
_
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate

Rownr = ActiveCell.Row
ColumnDep = 7
ShiftDown = 3

For i = 1 To 16
Range(Range("SearchDate").Offset(ShiftDown, 0), Range("SearchDate").
_
Offset(ShiftDown, 6)).Copy
Cells(Rownr, ColumnDep).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ShiftDown = ShiftDown + 1
ColumnDep = ColumnDep + 1
Next i

End Sub

--

Dave Peterson