Using IF in VBA - only works in first several instances

[jweasl]

I am using the same code over and over with different variables - but it's
only working the first 5 times. Instance 6,7 and 8 don't work - and I can't
figure it out.
Here's all the code :

Sub PasteClear()
'
' PasteClear Macro
' Macro recorded 7/31/2006 by Jeremy
'

'
Sheets("Item List").Select
Range("E2:E19").Select
Range("E19").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("E2").Select
End Sub
Sub HATOpaste()
'
' HATOpaste Macro
' Macro recorded 7/31/2006 by Jeremy
'

'
If Sheets("Item List").Range("E2").Value = Sheets("Item
List").Range("A3") Then Exit Sub
Application.ScreenUpdating = False
PasteClear
Range("A3:A18").Select
Range("A18").Activate
Selection.Copy
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E2").Select
Sheets("Quote").Select
Application.ScreenUpdating = True
End Sub
Sub PlenumPaste()
'
' PlenumPaste Macro
' Macro recorded 7/31/2006 by Jeremy
'

'
If Sheets("Item List").Range("E2").Value = Sheets("Item
List").Range("b4") Then Exit Sub
Application.ScreenUpdating = False
PasteClear
Range("B4:B20").Select
Selection.Copy
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E2").Select
Sheets("Quote").Select
Application.ScreenUpdating = True
End Sub
Sub DamperSleevePaste()
'
' DamperSleevePaste Macro
' Macro recorded 7/31/2006 by Jeremy
'

'
If Sheets("Item List").Range("E2").Value = Sheets("Item
List").Range("c5") Then Exit Sub
Application.ScreenUpdating = False
PasteClear
Range("C5:C16").Select
Selection.Copy
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E2").Select
Sheets("Quote").Select
Application.ScreenUpdating = True
End Sub
Sub HFSpaste()
'
' HFSpaste Macro
' Macro recorded 7/31/2006 by Jeremy
'

'
If Sheets("Item List").Range("E2").Value = Sheets("Item
List").Range("c19") Then Exit Sub
Application.ScreenUpdating = False
PasteClear
Range("C19:C22").Select
Application.CutCopyMode = False
Selection.Copy
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E2").Select
Sheets("Quote").Select
Application.ScreenUpdating = True
End Sub

Sub SealLockPaste()
'
' SealLockPaste Macro
' Macro recorded 7/31/2006 by Jeremy
'

'
If Sheets("Item List").Range("E2").Value = Sheets("Item
List").Range("d4") Then Exit Sub
Application.ScreenUpdating = False
PasteClear
Range("D416").Select
Selection.Copy
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E2").Select
Sheets("Quote").Select
Application.ScreenUpdating = True
End Sub
Sub TeeStandPaste()
'
' TeeStandPaste Macro
' Macro recorded 7/31/2006 by Jeremy
'

'
If Sheets("Item List").Range("E2").Value = Sheets("Item
List").Range("b24") Then Exit Sub
Application.ScreenUpdating = False
PasteClear
Range("B24:B25").Select
Application.CutCopyMode = False
Selection.Copy
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E2").Select
Sheets("Quote").Select
Application.ScreenUpdating = True
End Sub
Sub QuickLockPaste()
'
' QuickLockPaste Macro
' Macro recorded 8/1/2006 by Jeremy
'

'
If Sheets("Item List").Range("E2").Value = Sheets("Item
List").Range("d19") Then Exit Sub
Application.ScreenUpdating = False
PasteClear
Range("D1931").Select
Range("D30").Activate
Selection.Copy
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E2").Select
Sheets("Quote").Select
Application.ScreenUpdating = True
End Sub

Sub LSCPaste()
'
' LSCPaste Macro
' Macro recorded 8/2/2006 by Jeremy
'

'
If Sheets("Item List").Range("E2").Value = Sheets("Item
List").Range("c25") Then Exit Sub
Application.ScreenUpdating = False
PasteClear
Range("C25:C28").Select
Selection.Copy
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E2").Select
Sheets("Quote").Select
Application.ScreenUpdating = True
End Sub

 

[Bob Phillips]

Do you still get the problem if you simplify it like below?

Also, should you be qualifying the range copy with the sheet, as you do in
the initial test?

Sub PasteClear()
'
' PasteClear Macro
' Macro recorded 7/31/2006 by Jeremy
'
Sheets("Item List").Select
Range("E2:E19").Select
Range("E19").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("E2").Select
End Sub

Sub HATOpaste()
CopyData Sheets("Item List").Range("A3"), Range("A3:A18")
End Sub
Sub PlenumPaste()
CopyData Sheets("Item List").Range("B4"), Range("B4:B20")
End Sub
Sub DamperSleevePaste()
CopyData Sheets("Item List").Range("C5"), Range("C5:C16")
End Sub
Sub HFSpaste()
CopyData Sheets("Item List").Range("C19"), Range("C19:C22")
End Sub
Sub SealLockPaste()
CopyData Sheets("Item List").Range("D4"), Range("D416")
End Sub
Sub TeeStandPaste()
CopyData Sheets("Item List").Range("B24"), Range("B24:B25")
End Sub
Sub QuickLockPaste()
CopyData Sheets("Item List").Range("D19"), Range("D1931")
End Sub
Sub LSCPaste()
CopyData Sheets("Item List").Range("C25"), Range("C25:C28")
End Sub

Private Sub CopyData(testRange As Range, copyRange As Range)
If Sheets("Item List").Range("E2").Value = testRange Then Exit Sub
Application.ScreenUpdating = False
PasteClear
copyRange.Copy
Range("E2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E2").Select
Sheets("Quote").Select
Application.ScreenUpdating = True
End Sub


--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

 

[Tom Hutchins]

Not sure why the later instances don't work, but I rewrote your code as
follows and it seems to work:

Sub RunAll()
Call PasteData(Range("A3:A18")) 'HATO
Call PasteData(Range("B4:B20")) 'Pienum
Call PasteData(Range("C5:C16")) 'DamperSleeve
Call PasteData(Range("C19:C22")) 'HFS
Call PasteData(Range("D416")) 'SealLock
Call PasteData(Range("B24:B25")) 'TeeStand
Call PasteData(Range("D1931")) 'QuickLock
Call PasteData(Range("C25:C28")) 'LSC
End Sub

Sub PasteData(Rng1 As Range)
If Sheets("Item List").Range("E2").Value = _
Sheets("ItemList").Range(Rng1.Cells(1, 1).Address).Value _
Then Exit Sub
Application.ScreenUpdating = False
PasteClear
Rng1.Select
Selection.Copy
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("E2").Select
Sheets("Quote").Select
Application.ScreenUpdating = True
End Sub

Sub PasteClear()
Sheets("Item List").Select
Range("E2:E19").Select
Range("E19").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("E2").Select
End Sub

Hope this helps,

Hutch

 

[jweasl]

When I pasted your code I found my error - I had another call macro and had
left out the last 3 items. Thanks for your help!