VBA Loop Problem
 

The code below loops through the J column then pastes the formula in K1 into
the K column. However, it also pastes the code other places and does some
other strange stuff. How can I improve this code?

' Pastes a good formula back in
If TypeName(Selection) < "Range" Then Exit Sub
On Error Resume Next
Sheets("CEU Database").Range("K1").Copy
' Check the cells with constants
Sheets("CEU Database").Columns("J3:J65536").Select
For Each Cell In Selection.SpecialCells(xlConstants, 23)
If Cell.Value < "" Then
Cell.Offset(0, 1).PasteSpecial Paste:=xlAll,
Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
End If
Next Cell
End Sub

VBA Loop Problem
 

replace this line with this one and give it a try


Sheets("CEU Database").Range("J3:J65536").Select


-----Original Message-----
The code below loops through the J column then pastes the
formula in K1 into
the K column. However, it also pastes the code other
places and does some
other strange stuff. How can I improve this code?

' Pastes a good formula back in
If TypeName(Selection) < "Range" Then Exit Sub
On Error Resume Next
Sheets("CEU Database").Range("K1").Copy
' Check the cells with constants
Sheets("CEU Database").Columns("J3:J65536").Select
For Each Cell In Selection.SpecialCells
(xlConstants, 23)
If Cell.Value < "" Then
Cell.Offset(0, 1).PasteSpecial
Paste:=xlAll,
Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
End If
Next Cell
End Sub
.

VBA Loop Problem
 

try

Sub Don()
With Sheets("sheet1")
x = Cells(Rows.Count, "j").End(xlUp).Row
Range("k1").Copy .Range("j3:j" & x) _
..SpecialCells(xlConstants, 23).Offset(0, 1)
End With
End Sub

--
Don Guillett
SalesAid Software

"scrabtree23" wrote in message
...
The code below loops through the J column then pastes the formula in K1
into
the K column. However, it also pastes the code other places and does some
other strange stuff. How can I improve this code?

' Pastes a good formula back in
If TypeName(Selection) < "Range" Then Exit Sub
On Error Resume Next
Sheets("CEU Database").Range("K1").Copy
' Check the cells with constants
Sheets("CEU Database").Columns("J3:J65536").Select
For Each Cell In Selection.SpecialCells(xlConstants, 23)
If Cell.Value < "" Then
Cell.Offset(0, 1).PasteSpecial Paste:=xlAll,
Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
End If
Next Cell
End Sub