This code replicates a month removing certain elements from a current sheet but its quite slow....anyway to make this more efficient?
Code:
Private Sub CommandButton1_Click()
Dim NewSheet As Worksheet, NewName As String
Dim shname As Variant, v As Variant, s As Variant
Dim a, i As Long, temp As String
Dim Lr As Long
Application.DisplayAlerts = False
Sheets(ListBox1.Text).Copy , Sheets(ListBox1.Text)
ActiveSheet.Name = Format(DateAdd("yyyy", 1, DateValue("01 " & ListBox1.Text)), "mmm yyyy")
Application.DisplayAlerts = True
NewName = ActiveSheet.Name
Application.ScreenUpdating = False
For L = 190 To 17 Step -1
v = Cells(L, "I").Value
If v = "NTU" Or v = "Declined" Or v = "Non-Renewed" Or v = "Extended" Then
Range(Cells(L, 1), Cells(L, 11)).ClearContents
End If
Next
With Range("a18", Range("a" & Rows.Count).End(xlUp))
a = .Value
With CreateObject("VBScript.RegExp")
For i = 1 To UBound(a, 1)
.Pattern = "(.*\D)(\d+)(\D+)?$"
If .test(a(i, 1)) Then
temp = .Replace(a(i, 1), "$2")
a(i, 1) = .Replace(a(i, 1), "$1" & _
Format$(Val(temp) + 1, String(Len(temp), "0")) & "$3")
End If
Next
End With
.Value = a
End With
Range("A193:E250,K18:K190,G18:H190,I18:J190,B8:B9,E8:E9,H8:H9").ClearContents
For j = 2 To 8 Step 3
Sheets(NewName).Cells(10, j).Value = Sheets(ListBox1.Text).Cells(6, j).Value
Next j
Lr = Range("F" & Rows.Count).End(xlUp).Row
Range("I18:I" & Lr) = "WIP"
Range("J18:J" & Lr) = "Amber"
Call FormattingGlobal
Call ListSheets
MsgBox "Replicate month complete!"
Application.ScreenUpdating = True
End Sub