need to transform this into vba Code

[Adrcon3]

Hi. well i'm not very efficent in vba as of right now and i need someone to translate the following for me into VBA if possible.

dim sheetName as string
dim isSheet as bool
if more than 1 cell is selected than
 msgbox ("too many cells selected")
 exit sub
else
sheetName = Trim(selectedcell.text)
end if
for i=1 to total amount of sheets(sheets.count?)
  if Sheet(i).name = sheetName then
     isSheet = true (sheetwork exists with such name)
     msgbox("sheet " & sheetName & " already exists.")
     exit loop
  end if
next i
if not isSheet then
  sheets.add
  sheets.name = sheetName
   ActiveWorkbook.Save
   ActiveWorkbook.Close
end if

Thanks

 

[Reid]

You were pretty close. Here is some code that does what you are trying to do. There is probably a better way to test if there is more than one cell in the selected range, but this works. Hope this helps.

Code:

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> NameSheet()

    <SPAN style="color:#00007F">Dim</SPAN> sheetName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> isSheet <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> inRange <SPAN style="color:#00007F">As</SPAN> Range, cell <SPAN style="color:#00007F">As</SPAN> Range
    <SPAN style="color:#00007F">Dim</SPAN> CellCounter <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>
    
    isSheet = <SPAN style="color:#00007F">False</SPAN>
    CellCounter = 0
    <SPAN style="color:#00007F">Set</SPAN> inRange = Selection
    
    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> cell <SPAN style="color:#00007F">In</SPAN> inRange
        CellCounter = CellCounter + 1
    <SPAN style="color:#00007F">Next</SPAN> cell
    
    <SPAN style="color:#00007F">If</SPAN> CellCounter > 1 <SPAN style="color:#00007F">Then</SPAN>
     MsgBox ("Too many cells selected")
     <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
    <SPAN style="color:#00007F">Else</SPAN>
        sheetName = inRange.Value
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    
    <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> Sheets.Count
      <SPAN style="color:#00007F">If</SPAN> Sheets(i).Name = sheetName <SPAN style="color:#00007F">Then</SPAN>
         isSheet = <SPAN style="color:#00007F">True</SPAN>
         MsgBox ("sheet " & sheetName & " already exists.")
         <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">For</SPAN>
      <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">Next</SPAN> i
    
    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> isSheet <SPAN style="color:#00007F">Then</SPAN>
        Worksheets.Add.Name = sheetName
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[erik.van.geit]

Hi,

some code to compare
no loops: not a big deal here but it's good practice to avoid timeconsuming code
onliner to close

Sub NameSheet()
'this code will not check for valid sheetname !!

    Dim sheetName As String
    Dim checkit As String
    If Selection.Count > 1 Then
     MsgBox ("Please select only one cell"), vbCritical, "selection ERROR"
     Exit Sub
    Else
    sheetName = ActiveCell.Value
    End If
    
    On Error Resume Next
    checkit = Sheets(sheetName).Name
    On Error GoTo 0
    
        If checkit = "" Then
        Worksheets.Add.Name = sheetName
        ActiveWorkbook.Close True
        End If
    
End Sub

kind regards,
Erik

EDIT: onliner must be oneliner

 

[Reid]

Erik,

Much better code. Thanks. One minor addition to provide the notification if the sheet already exists:

Sub NameSheet()
'this code will not check for valid sheetname !!

Dim sheetName As String
Dim checkit As String
If Selection.Count > 1 Then
MsgBox ("Please select only one cell"), vbCritical, "selection ERROR"
Exit Sub
Else
sheetName = ActiveCell.Value
End If

On Error Resume Next
checkit = Sheets(sheetName).Name
On Error GoTo 0

If checkit = "" Then
Worksheets.Add.Name = sheetName
ActiveWorkbook.Close True
Else
MsgBox ("Sheet " & sheetName & " already exists")
End If

End Sub

 

[erik.van.geit]

thanks !
forgot that part

 

[Adrcon3]

thank you so much guys.
just need some clarifications of the statemants below.

On Error Resume Next -> when an error occurs ...resume next?
On Error GoTo 0 -> when an error occurs go back to line 0 of the code?

thanks again

 

[erik.van.geit]

On Error Resume Next 
....
On Error GoTo 0

when you try to divide by zero you get an error
errors need to be "handled" else the code can't go any further

On Error Resume Next tells to jump to the next instruction
FINE CODE :wink: BUT you can imagine the problems if a lot of instructions are skipped whithout you want this to happen

an other way to handle errors is to send the code to another line
on Error GoTo skip

Sub test()
shn = "kilimanjaro"
On Error Resume Next
Sheets(shn).Select
MsgBox "did you see the sheet " & shn & "?", 32, UCase(shn)
On Error GoTo skip
Sheets(shn).Select
MsgBox "not displayed"
skip:
MsgBox "did you see the sheet " & shn & "?", 32, "SKIP"
Sheets(shn).Select 'error occuring
End Sub

On Error GoTo 0 means you stop the error handling from there
If you don't do this and your code contains errors you won't see them

take a look at the help files for "On Error"

I like using "resume next" just before the potential problem and "closing the on error" using "goto 0"

Sub test()
'does range exist
Dim i As Integer
Dim c As Range

For i = -1 To 3
Set c = Nothing
    On Error Resume Next
    Set c = Cells(i, 1)
    On Error GoTo 0
If Not c Is Nothing Then Cells(i, 1).Interior.ColorIndex = 3
Next i

End Sub

 

[Adrcon3]

ohh i see.
thanks for your help

 

[erik.van.geit]

you're welcome
feel free to come back for more