Your code seems to give you much grief and little comfort. The reason is that you didn't take a strictly logical approach. The tasks are ...
1. Find the last used number. I suggest to use VBA's own `Find` function.
2. Insert the next number. It consists of prefix, Date and serial number.
So, you arrive at code like this:-
Sub STO_66112119()
' 168
Const NumClm As Long = 1 ' 1 = column A
Dim Prefix As String
Dim LastNumber As Long
Dim Fnd As Range ' search result
Prefix = "JS" ' you could get this from an InputBox to
' enable numbering for other prefixes
With Columns(NumClm)
On Error Resume Next ' if column A is blank
Set Fnd = .Find(What:=Prefix, _
After:=.Cells(1, 1), _
LookIn:=xlValues, _
Lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
End With
LastNumber = Val(Right(Fnd.Value, 5))
On Error GoTo 0
Cells(Rows.Count, NumClm).End(xlUp).Offset(1).Value = Prefix & Format(Date, "yyyymm") _
& Format(LastNumber + 1, "00000")
End Sub
You need to spend a moment on preparation, however.
1. Define the column to work in. I put this in the `Const NumClm`. It's at the top of the code so as to make maintenance easier (won't need to dig in the code to make a change).
2. My code shows `Prefix = "JS"`. You want to change this to "CP". I inserted "JS" to show that you could use any prefix.
The above code will continue counting up in a new month and even a new year. If you want to start each year with a new series just change the way you handle the found previous. The `Find` function will return the cell where the prefix was last used. You might further examine that cell's value.
The code below will remove all null strings at the bottom of columns as well as those that contain zeroes.
Sub ClearBlankCells()
' 146
Dim Rng As Range ' working range
Dim R As Long ' intermediate: row
Dim C As Long ' loop counter: columns
Application.ScreenUpdating = False
With ActiveSheet
With .Range("B2:GQ244")
.Formula = "=IF(ISERROR(FIND( B$1,Sheet9!$H34)),"""",Sheet9!$I34)"
' replace formulas with their values
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
For C = 2 To 200 Step 1
Set Rng = .Columns(C)
R = Application.Evaluate("SUMPRODUCT((" & Rng.Address & "<>"""")*(" & _
Rng.Address & "<>0)*1)")
If R > 0 Then
Set Rng = Range(.Cells(R + 1, C), .Cells(Rows.Count, C))
Rng.ClearContents
End If
' sort by column
' Range(.Cells(2, C), .Cells(245, C)).Sort Key1:=.Cells(2, C), Order1:=xlAscending
Next C
End With
Application.ScreenUpdating = True
End Sub
Note that no blanks or zeroes may be included in the block of data above the bottom of each column, including the caption.
Sorting must be done after such cells have been removed but I left the sort instructions dimmed out because it's wrong either in syntax or by concept. If you need to sort each column the syntax is wrong because the syntax sorts the entire sheet. On the other hand, if you want to sort the entire sheet you don't have to do it in a loop 200 times.
The code runs very slowly which gives rise to two observations.
1. It spends 99% of its time repairing the damage it has done in its first line.
2. It looks at a data range which is vastly bigger than what is actually, reasonably, required. Nobody wants to look at a sheet 200 columns and 244 rows.
Therefore there must be much better ways to do achieve what you want.
