Need help wth a Macro

[frogman]

I found this on here and need some help. I am using this Macro to copy a sheet and when it copies the tab number increments for example from Game#25 to Game#26. The problem I am having is when I get into the 1000's for a Game# it does not increment and it does something like this Game#1005, Game#1005-1, Game#1005-2. What can I change in the Macro to correct this? Also is there a way when it copies an Even number tab it makes it green and an odd number tab it makes it red?

Thank you for your help

Sub Copy_Me()
Const mycolumns = "A,C,D,E,F,L,N,O,P,Q,W,Y,Z,AA,AB"
Dim tmp As String, num As Long, i As Long, j As Long, minus1 As Boolean, finalbracket As Boolean, skipped As Long, adr As String, col, whereerrors As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

ActiveSheet.Copy After:=Sheets(Sheets.Count)
tmp = Replace(ActiveSheet.Name, " (2)", "")
num = InStrRev(tmp, " ")
On Error Resume Next
  ActiveSheet.Name = Left(tmp, num) & 1 + Mid(tmp, num + 1)
' If Err.Number <> 0 Then MsgBox "Please check created sheet name!", vbCritical
On Error GoTo 0
Range("B25").Value = Range("B25").Value + 1
col = Split(mycolumns, ",")
For j = LBound(col) To UBound(col)
  For i = 3 To 35
    If Cells(i, col(j)).HasFormula Then
      tmp = Cells(i, col(j)).Formula
      If Right(tmp, 1) = ")" Then
        finalbracket = True
        tmp = Left(tmp, Len(tmp) - 1)
      Else
        finalbracket = False
      End If
      If Right(tmp, 2) = "-1" Then
        minus1 = True
        tmp = Left(tmp, Len(tmp) - 2)
      Else
        minus1 = False
      End If
      num = InStrRev(tmp, "!")
      On Error Resume Next
        adr = Range(Mid(tmp, num + 1)).Offset(-1, 0).Address(False, False)
        If Err.Number <> 0 Then
          skipped = skipped + 1
          whereerrors = whereerrors & ", " & Cells(i, col(j)).Address
        Else
          Cells(i, col(j)).Formula = Left(tmp, num) & adr & IIf(minus1, "-1", "") & IIf(finalbracket, ")", "")
        End If
      On Error GoTo 0
    End If
  Next i
Next j
If skipped <> 0 Then MsgBox "Please check formulas!" & vbNewLine & "probably there are errors in " & skipped & " of them." & wbnewline & Mid(whereerrors, 3), vbCritical

Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.Calculate
End Sub

Sub make_10_consequtive_copies()
Dim i As Integer
For i = 1 To 10
  Call Copy_Me
Next i
End Sub

Incorrect

incements with dash.jpg

correct

correct increment.jpg

[Paul_Hossler]

You On Error Resume Next was ignoring that num=0 since you replaced the space you were looking for the line above

Try this bit

Option Explicit
Sub Copy_Me()
    Const mycolumns = "A,C,D,E,F,L,N,O,P,Q,W,Y,Z,AA,AB"
    Dim tmp As String, num As Long, i As Long, j As Long, minus1 As Boolean, finalbracket As Boolean, skipped As Long, adr As String, col, whereerrors As String
    Dim v As Variant
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
     
    v = Split(ActiveSheet.Name, "#")
    ActiveSheet.Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = v(0) & "#" & (v(1) + 1)

    If (v(1) + 1) Mod 2 = 0 Then  'even
        ActiveSheet.Tab.Color = vbGreen
    Else
        ActiveSheet.Tab.Color = vbRed
    End If
    

     
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.Calculate
End Sub
 
Sub make_10_consequtive_copies()
    Dim i As Integer
    For i = 1 To 10
        Call Copy_Me
    Next i
End Sub

[SamT]

Have you tried something simple like

Name= "Game" & Sheets.Count +/- n

[frogman]

Thanks Paul, this does increment the tab but does not do what the rest of the macro needs to do which ALW increments up a number in the formula and C:F,N:Q,Y:AB increments does a number on the formulas. All other cells stay the same (exact copy),

is there a way to change what I provided and just add the tab portion or did I do something wrong?

Thanks

[Paul_Hossler]

I deleted the stuff that didn't seem like it was part of the question about tab names and color

Just add back what you need after the Color code lines

You might have to fix it a little, but I really didn't look at it since there was no test data and no attachment

[SamT]

ActiveSheet.Name = Left(tmp, num) & 1 + Mid(tmp, num + 1)

ActiveSheet.Name = Left(tmp, num) & 1 + CStr(CLng(Right(tmp, num + 1)))

[frogman]

Hey guys, I am a newbie with all this vba and struggling to put this all together.&nbsp; I can get the tabs to work but nothing else or get the sequence to work but the tabs leaves a single digit, can someone put this altogether for me to try please? <br><br>Thanks

[mdmackillop]

Refer to Post #5

[frogman]

Thanks i finally got it now i think

[mdmackillop]

Please share your result for the benefit of others.