ActiveCell Value match with Cells in range problems

[Axel]

Hi developers!
Am stuck again.
I use many hours try to solve my problems before I ask for an solution
her, but my skills just not high enough.

The problem i sto make a Match entry loop.
This is explained in the macro below.
Am very greateful for all help!

Aksel

Private Sub CommandButton1_Click()

Dim c As range
Dim v As range
'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
'Send to the error message if all the cell in range v has been used
If IsEmpty(c) Then GoTo line1 Else GoTo line3
line1:
'The selection from 3 comboboxes is set in the first empty cell
c.Value = ComboBox1.Text & "." & ComboBox2.Text & ComboBox3.Text

'Here is my problem. I want to check that the user don't selected the
same text
'several times, because the the text result in range "v" is going to be
sheet names.
'So the cant be duplicate names.
'I have tryed many solutions, but no success
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''
If Not IsEmpty(c) Then
With c
For Each c In v
If Evaluate(.Value & c) = True Then MsgBox "Duplicate
sizes no allowed"
GoTo line3
Next c
End With
End If



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''
'Here all is working
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:
Application.CutCopyMode = False
End Sub

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

 

[Dave Peterson]

dim myStr as string
.....
'combine all your strings
myStr = ComboBox1.Text & "." & ComboBox2.Text & ComboBox3.Text

if application.countif(v,mystr) > 0 then
'already there
'warning message or what?
'exit sub '?????
else
'do the real work
end if

 

[Axel]

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 ***