Hi all.
I have long piece of code, part of which copies a worksheet "ABACUS" and renames it W.E.dd.mm.yy. What I would like, is to able to check if the intended renamed worksheet exists, if it does show a meesage box and end the code, otherwise continue the code.
the piece of code I have to copy and rename the sheet is,
The entire code is,
Some of you guys will have gathered my understanding of VBA is extremely limited, so I'd be very grateful for any assistance with this.
Many thanks
I have long piece of code, part of which copies a worksheet "ABACUS" and renames it W.E.dd.mm.yy. What I would like, is to able to check if the intended renamed worksheet exists, if it does show a meesage box and end the code, otherwise continue the code.
the piece of code I have to copy and rename the sheet is,
VBA Code:
'copy and save worksheet with name format W.E.dd.mm.yy
ActiveSheet.Copy After:=Worksheets("OVERTIME")
ActiveSheet.Name = "W.E." & Format(Range("C2").Value, "dd.mm.yy")
The entire code is,
VBA Code:
Public Sub CopySheetAndRenamePredefined()
'check date format
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim response As String
For Each ws In Sheets
If ws.Range("B2") <> "" And ws.Range("C2") = "" Then
Do
response = InputBox("Input date in format **/**/**")
If response <> "" Then
ws.Range("C2") = response
Exit Do
ElseIf response = "" Then
MsgBox ("You must enter date in format **/**/**")
Else: Exit Do
End If
Loop
End If
Next ws
Application.ScreenUpdating = True
Dim arr1 As Variant
Dim arr2 As Variant
Dim i As Long
Dim dte As Date
Dim writeCel As Range
' determine where to start
With Sheets("OVERTIME")
Set writeCel = .Range("A" & .Rows.Count).End(xlUp).Offset(1)
End With
With ActiveSheet
'-----SUNDAY-----
'add overtime and absence sunday
dte = .Range("M2").Value
arr1 = .Range("AI21:AI32").Value
arr2 = .Range("CY21:CY32").Value
For i = LBound(arr1) To UBound(arr1)
If arr2(i, 1) = "A" Then
arr1(i, 1) = arr2(i, 1)
End If
Next i
' write to sheet and clear arrays
writeCel = dte
writeCel.Offset(0, 1).Resize(, UBound(arr1)).Value = Application.Transpose(arr1)
Set arr1 = Nothing
Set arr2 = Nothing
'-----MONDAY-----
'add overtime and absence monday
dte = .Range("AC2").Value
arr1 = .Range("AK21:AK32").Value
arr2 = .Range("DA21:DA32").Value
For i = LBound(arr1) To UBound(arr1)
If arr2(i, 1) = "A" Then
arr1(i, 1) = arr2(i, 1)
End If
Next i
' write to sheet and clear arrays
writeCel.Offset(1) = dte
writeCel.Offset(1, 1).Resize(, UBound(arr1)).Value = Application.Transpose(arr1)
Set arr1 = Nothing
Set arr2 = Nothing
'-----TUESDAY-----
'add overtime and absence tuesday
dte = .Range("AS2").Value
arr1 = .Range("AM21:AM32").Value
arr2 = .Range("DC21:DC32").Value
For i = LBound(arr1) To UBound(arr1)
If arr2(i, 1) = "A" Then
arr1(i, 1) = arr2(i, 1)
End If
Next i
' write to sheet and clear arrays
writeCel.Offset(2) = dte
writeCel.Offset(2, 1).Resize(, UBound(arr1)).Value = Application.Transpose(arr1)
Set arr1 = Nothing
Set arr2 = Nothing
'-----WEDNESDAY-----
'add overtime and absence wednesday
dte = .Range("BI2").Value
arr1 = .Range("AO21:AO32").Value
arr2 = .Range("DE21:DE32").Value
For i = LBound(arr1) To UBound(arr1)
If arr2(i, 1) = "A" Then
arr1(i, 1) = arr2(i, 1)
End If
Next i
' write to sheet and clear arrays
writeCel.Offset(3) = dte
writeCel.Offset(3, 1).Resize(, UBound(arr1)).Value = Application.Transpose(arr1)
Set arr1 = Nothing
Set arr2 = Nothing
'-----THURSDAY-----
'add overtime and absence thursday
dte = .Range("BY2").Value
arr1 = .Range("AQ21:AQ32").Value
arr2 = .Range("DG21:DG32").Value
For i = LBound(arr1) To UBound(arr1)
If arr2(i, 1) = "A" Then
arr1(i, 1) = arr2(i, 1)
End If
Next i
' write to sheet and clear arrays
writeCel.Offset(4) = dte
writeCel.Offset(4, 1).Resize(, UBound(arr1)).Value = Application.Transpose(arr1)
Set arr1 = Nothing
Set arr2 = Nothing
'-----FRIDAY-----
'add overtime and absence friday
dte = .Range("CO2").Value
arr1 = .Range("AS21:AS32").Value
arr2 = .Range("DI21:DI32").Value
For i = LBound(arr1) To UBound(arr1)
If arr2(i, 1) = "A" Then
arr1(i, 1) = arr2(i, 1)
End If
Next i
' write to sheet and clear arrays
writeCel.Offset(5) = dte
writeCel.Offset(5, 1).Resize(, UBound(arr1)).Value = Application.Transpose(arr1)
Set arr1 = Nothing
Set arr2 = Nothing
'-----SATURDAY-----
'add overtime saturday no absence
dte = .Range("DE2").Value
arr1 = .Range("AU21:AU32").Value
' write to sheet and clear array
writeCel.Offset(6) = dte
writeCel.Offset(6, 1).Resize(, UBound(arr1)).Value = Application.Transpose(arr1)
Set arr1 = Nothing
End With
Dim frstCel As Range
Dim fillRng As Range
'-----For formulas and/or under lining-------
writerow = writeCel.Offset(6, 1).Row
With Sheets("OVERTIME")
'Debug.Print Application.CountIf(.Range("B10:B" & writeRow), "Sat") Mod 4
If Application.CountIf(.Range("B10:B" & writerow), "Sat") Mod 4 = 0 Then
.Range("N" & writerow).FormulaR1C1 = "=SUM(R[-27]C[-11]:RC[-11])"
.Range("N" & writerow).AutoFill Destination:=.Range("N" & writerow).Resize(, 11)
.Range("N" & writerow).Resize(, 11).HorizontalAlignment = xlCenter
With .Range("A" & writerow & ":X" & writerow).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
End With
Else
With .Range("A" & writerow & ":X" & writerow).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End If
End With
'copy and save worksheet with name format W.E.dd.mm.yy
ActiveSheet.Copy After:=Worksheets("OVERTIME")
ActiveSheet.Name = "W.E." & Format(Range("C2").Value, "dd.mm.yy")
'delete save button add save changes button
ActiveSheet.Shapes("Button 1").Delete
ActiveSheet.Buttons.Add(75, 150, 150, 100).Select
With Selection
.Name = "New Button"
.OnAction = "Button3_Click"
.Text = "SAVE CHANGES"
.Font.Size = 24
.Font.Bold = True
ActiveSheet.Range("D5").Select
End With
'ABACUS clear cells and reset tasks
Worksheets("ABACUS").Activate
Range("D5:DK17").ClearContents
Range("CY22:DJ32").ClearContents
Range("C2").ClearContents
Range("BP22:CE33").ClearContents
Range("BE22:BV32").ClearContents
Range("E3,G3,I3,K3,M3,O3,Q3,S3,U3,W3,Y3,AA3,AC3,AE3,AG3,AI3,AK3,AM3,AO3,AQ3,AS3,AU3,AW3,AY3,BA3,BC3,BE3,BG3,BI3,BK3,BM3,BO3").ClearContents
Range("BQ3,BS3,BU3,BW3,BY3,CA3,CC3,CE3,CG3,CI3,CK3,CM3,CO3,CQ3,CS3,CU3,CW3,CY3,DA3,DC3,DE3,DG3,DI3,DK3").ClearContents
[B25] = Range("DM2").Value
[B26] = Range("DM2").Value
[B27] = Range("DM2").Value
[B28] = Range("DM2").Value
[B29] = Range("DM2").Value
[B30] = Range("DM2").Value
[B31] = Range("DM2").Value
[B32] = Range("DM2").Value
End Sub
Some of you guys will have gathered my understanding of VBA is extremely limited, so I'd be very grateful for any assistance with this.
Many thanks