' Attention!!!! Following reference has to be addded to project
' Microsoft Visual Basic for Applications Extensibility 5.3.
' Source:
' https://www.mrexcel.com/forum/excel-...mbers-vba.html
' https://windowssecrets.com/forums/sh...rs-in-VBA-code
Sub AddLineNumbers()
Dim i As Long, j As Long, lineN As Long
Dim procName As String
Dim startOfProceedure As Long
Dim lengthOfProceedure As Long
Dim ModuleName As String
Dim ReplaceJump, LineValue, PrevLineValue, LenLine, YesNo
ModuleName = InputBox("Please write Modul name to add line numbers")
'ModuleName = "YourModuleName" 'Paste module name where lines' numbers should be added
YesNo = MsgBox("Would you like to add code lines to module: '" & ModuleName & "'?", vbQuestion + vbYesNo, "QUESTION...")
If YesNo = 6 Then
With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
For i = 1 To .CountOfLines
procName = .ProcOfLine(i, vbext_pk_Proc)
If procName <> vbNullString Then
startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc)
If i = startOfProceedure Then
lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc)
For j = 2 To lengthOfProceedure - 2
lineN = startOfProceedure + j
' ----------------------------
' EXCLUSION
LineValue = .lines(lineN, 1)
PrevLineValue = .lines(lineN - 1, 1)
If Len(Trim(.lines(lineN, 1))) = 0 Then
GoTo ReplaceJump
End If
If Right(PrevLineValue, 1) = "_" Then
.ReplaceLine lineN, " " & vbTab & vbTab & .lines(lineN, 1) 'ori
GoTo ReplaceJump
End If
If Right(LineValue, 1) = ":" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 4) = "Case" Then
.ReplaceLine lineN, " " & vbTab & vbTab & .lines(lineN, 1) 'ori
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 6) = "Public" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "Private" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 3) = "Sub" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 8) = "Function" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 12) = "End Function" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 3) = "Debug" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "End Sub" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 1) = "'" Then
.ReplaceLine lineN, vbTab & vbTab & .lines(lineN, 1) 'ori
GoTo ReplaceJump
End If
' ----------------------------
' ADDING LINE CODE
If lineN < 100 Then
.ReplaceLine lineN, CStr(lineN) & ":" & vbTab & vbTab & .lines(lineN, 1)
Else
.ReplaceLine lineN, CStr(lineN) & ":" & vbTab & .lines(lineN, 1)
End If
ReplaceJump:
Next j
End If
End If
Next i
End With
MsgBox "Code lines has been added.", vbInformation, "CONFIRMATION..."
Else
MsgBox "Canceled."
End If
End Sub
' Attention!!! Following reference has to be added:
' Microsoft Visual Basic for Applications Extensibility 5.3.
' Source:
' https://www.mrexcel.com/forum/excel-...mbers-vba.html
' https://windowssecrets.com/forums/sh...rs-in-VBA-code
Sub RemoveLineNumber()
' REMOVING CODE LINES
Dim i As Long, j As Long, lineN As Long
Dim procName As String
Dim startOfProceedure As Long
Dim lengthOfProceedure As Long
Dim ModuleName As String
Dim ReplaceJump, LineValue, PrevLineValue, LenLine, YesNo
ModuleName = InputBox("Please write Modul name to remove line numbers")
'ModuleName = "YourModuleName" 'Paste module name where code lines has to be removed
YesNo = MsgBox("Would you like to remove lines numbers from: '" & ModuleName & "'?", vbQuestion + vbYesNo, "QUESTION...")
If YesNo = 6 Then
With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
For i = 1 To .CountOfLines
procName = .ProcOfLine(i, vbext_pk_Proc)
If procName <> vbNullString Then
startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc)
If i = startOfProceedure Then
lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc)
For j = 2 To lengthOfProceedure - 2
lineN = startOfProceedure + j
' ----------------------------
' EXCLUSION
LineValue = .lines(lineN, 1)
PrevLineValue = .lines(lineN - 1, 1)
If Len(.lines(lineN, 1)) = 0 Then
.ReplaceLine lineN, .lines(lineN, 1)
GoTo ReplaceJump
End If
If Right(PrevLineValue, 1) = "_" Then
.ReplaceLine lineN, Right(.lines(lineN, 1), Len(.lines(lineN, 1)) - 8)
GoTo ReplaceJump
End If
If Right(LineValue, 1) = ":" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 4) = "Case" Then
.ReplaceLine lineN, Right(.lines(lineN, 1), Len(.lines(lineN, 1)) - 8)
End If
If Left(Trim(LineValue), 6) = "Public" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "Private" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 3) = "Sub" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 3) = "Debug" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 8) = "Function" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 12) = "End Function" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "End Sub" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 7) = "" Then
GoTo ReplaceJump
End If
If Left(Trim(LineValue), 1) = "'" Then
.ReplaceLine lineN, Right(.lines(lineN, 1), Len(.lines(lineN, 1)) - 8)
GoTo ReplaceJump
End If
' ----------------------------
' REMOVING LINE'S NUMBER
.ReplaceLine lineN, Right(.lines(lineN, 1), Len(.lines(lineN, 1)) - 8)
ReplaceJump:
Next j
End If
End If
Next i
End With
MsgBox "Line number has been removed.", vbInformation, "CONFIRMATION..."
Else
MsgBox "Canceled."
End If
End Sub