View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Sean Sean is offline
external usenet poster
 
Posts: 454
Default What is the Cause of this Error Q

On Sep 23, 1:34 pm, Dave Peterson wrote:
Is your worksheet protected?

Sean wrote:

I am hitting debug 1004


"Unable to get th SpecialCells property of the Range class"


Any suggestions on what is causing this and how do I amend?


Thanks


--

Dave Peterson



Code is pretty long, but see below, the problem area is in

.Range("AI3:AI4").Cells.SpecialCells(xlCellTypeCon stants)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"

This is where is obtains an e-mail address (which on my sheet are
valid). It has worked fine in the past but now its suddenly thrown up
this error


Sub Mail_New_Version()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

Sheets("E-Figures").Visible = True
Sheets("E-Access").Visible = True

Sheets("E-Figures").Select
ActiveSheet.Unprotect Password:="123"

'Copy the sheets to a new workbook
Sourcewb.Sheets(Array("E-Figures", "E-Access", "Rules")).Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security
dialog that you only
'see when you copy a sheet from a xlsm file with macro's
disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

' 'Change all cells in the worksheets to values if you want
' For Each sh In Destwb.Worksheets
' sh.Select
' With sh.UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False
' Destwb.Worksheets(1).Select
' Next sh

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-
mmm-yy hh-mm")

ActiveWindow.TabRatio = 0.908

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)


Sheets("E-Figures").Activate
Range("A1").Select

For Each cell In ThisWorkbook.Sheets("E-
Figures").Range("BJ1:BJ18")
strbody = strbody & cell.Value & vbNewLine
Next


For Each cell In ThisWorkbook.Sheets("E-Figures") _
.Range("AI3:AI4").Cells.SpecialCells(xlCellTypeCon stants)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)