PDA

View Full Version : Need help wth a Macro



frogman
07-13-2016, 04:06 AM
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

16609

correct

16610

Paul_Hossler
07-13-2016, 07:37 AM
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
07-13-2016, 07:39 AM
Have you tried something simple like

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

frogman
07-13-2016, 08:10 AM
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
07-13-2016, 08:28 AM
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
07-13-2016, 09:43 AM
ActiveSheet.Name = Left(tmp, num) & 1 + Mid(tmp, num + 1)


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

frogman
07-15-2016, 06:12 AM
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
07-15-2016, 06:28 AM
Refer to Post #5

frogman
08-06-2016, 08:08 AM
Thanks i finally got it now i think

mdmackillop
08-07-2016, 03:09 AM
Please share your result for the benefit of others.