Hi there,
The following version of your code seems to "work" (insofar as no error messages are generated) but, as I'm not sure of what your precise requirements are, it may require further modification by yourself:
Sub Cont_Load()
With Sheet1
If .Range("B2").Value = Empty Then Exit Sub
.Range("B4").Value = True ' Set contact Load to True
ContRow = .Range("B2").Value ' Contact Row
For ContCol = 4 To 10
.Cells(11, ContCol).Value = .Cells(ContRow, ContCol).Value
Next ContCol
On Error Resume Next
.Shapes("ThumbPic").Delete ' Delete thumbnail picture (if any)
On Error GoTo 0
If .Range("M4").Value <> Empty Then Cont_DisplayThumb
End With
End Sub
Sub Cont_New()
With Sheet1
''' .Range("B2,E5,E7,E9,H5,H7,H9,M4").ClearContents ' <<< ClearContents cannot be used on a merged cell
.Range("B2,E5,E7,E9,H5,H7,H9,M4").Value = vbNullString
.Range("B4").Value = True ' Contact Load
.Range("B3").Value = True ' New Contact
.Range("B4").Value = False ' Contact Load to False
.Range("E5").Select
.Shapes("ExistContGrp").Visible = msoFalse
''' .Shapes("NewContGrp").Visible = msoCTrue ' <<< DOES NOT EXIST
End With
End Sub
Sub Cont_Save()
With Sheet1
If .Range("E5").Value = Empty Then
MsgBox "Please enter your Name"
Exit Sub
End If
ContRow = .Range("D99999").End(xlUp).Row + 1 ' First available Row
For ContCol = 4 To 20
.Cells(ContRow, ContCol).Value = .Cells(11, ContCol).Value
Next ContCol
.Shapes("ExistContGrp").Visible = msoCTrue
''' .Shapes("NewContGrp").Visible = msoFalse ' <<< DOES NOT EXIST
.Range("B3").Value = False
End With
End Sub
Hope this helps - please let me know how you get on.
Regards,
Greg M
Bookmarks