View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Axel Axel is offline
external usenet poster
 
Posts: 40
Default ActiveCell Value match with Cells in range problems


Thank you very much! Dave.
it worked perfekt
I can finaly go to sleep.






Private Sub CommandButton1_Click()
ActiveSheet.Unprotect Password:="driller"
Dim myStr As String
Dim c As range
Dim v As range
'combine all strings
myStr = ComboBox1.Text & "." & ComboBox2.Text & ComboBox3.Text
'Set the range for comboboxes result
Set v = range("I8:I14")
'find the first empty cell in range
For Each c In v
If IsEmpty(c) Then Exit For
Next c
'Sen to the error message if all the cell in range v has been used
If IsEmpty(c) Then GoTo line1 Else GoTo line3
line1:
If Application.CountIf(v, myStr) 0 Then
MsgBox "This size is already used"
Exit Sub
Else
'The selection from 3 comboboxes is set in the first empty cell
c.Value = ComboBox1.Text & "." & ComboBox2.Text & ComboBox3.Text
c.Copy
'Selecting a new range to results from range v
c.Offset(0, 5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'Because the comboboxes has (/) and ("), I have to replace it with (.)
so
'it can be legal sheetnames
Selection.Replace What:=Chr(47), _
Replacement:=Chr(46), LookAt:=xlPart, SearchOrder:=xlByRows
Selection.Replace What:=Chr(34), _
Replacement:=Chr(32), LookAt:=xlPart, SearchOrder:=xlByRows
GoTo lastline
line3:
MsgBox "The are no more sheets! Use the clear button to apply changes"
lastline:
End If
Application.CutCopyMode = False
ActiveSheet.Protect Password:="driller", DrawingObjects:=True, _
Contents:=True, Scenarios:=True
End Sub


*** Sent via Developersdex http://www.developersdex.com ***