Dim tp As Integer
Dim str, flt(), strflt, sflt As String
Dim l, l1, l2, l3, i, j, t As Integer

'Title code
Private Sub Title_Change()
Dim commas As Integer
Dim pos As Integer
Dim str As String
l = Len(Title.Text)
If l >= 80 Then
MsgBox "Title Exceeded the Maximum Length"
End If

If l = 0 Then
Tchar = 0
Tcommos.Text = 0
Tamp.Text = 0
Tpipe.Text = 0
Tdem = 0
Tdots = 0
End If

For j = 1 To l
If Mid$(Title.Text, j, 1) = "," Then
commas = commas + 1
Tcommos.Text = commas
End If
If Mid$(Title.Text, j, 1) = "&" Then
amp = amp + 1
Tamp.Text = amp
End If
If Mid$(Title.Text, j, 1) = "|" Then
pipe = pipe + 1
Tpipe.Text = pipe
End If
If Mid$(Title.Text, j, 1) = "0" Then
Tamp.Text = 0
End If
If Mid$(Title.Text, j, 1) = "." Then
dots = dots + 1
Tdots.Text = dots
End If
If Mid$(Title.Text, j, 1) = "-" Then
dem = dem + 1
Tdem.Text = dem
End If
Next j
End Sub
Private Sub Title_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Tchar.Text = Title.TextLength - 1

End Sub
Private Sub Title_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Tchar.Text = Title.TextLength + 1
End Sub

'Description Code
Private Sub Desc_Change()
l1 = Len(Desc.Text)
If l1 >= 200 Then
MsgBox "Description Exceeded the Maximum Length"
End If
If l1 = 0 Then
Dcommos.Text = 0
Damp.Text = 0
Dpipe.Text = 0
Ddots.Text = 0
Ddem.Text = 0
Dchar.Text = 0
End If
For i = 1 To l1
If Mid$(Desc.Text, i, 1) = "," Then
commas = commas + 1
Dcommos.Text = commas
End If
Next i
For k = 1 To l1
If Mid$(Desc.Text, k, 1) = "&" Then
amp = amp + 1
Damp.Text = amp
End If
If Mid$(Desc.Text, k, 1) = "|" Then
pipe = pipe + 1
Dpipe.Text = pipe
End If
If Mid$(Desc.Text, k, 1) = "." Then
dots = dots + 1
Ddots.Text = dots
End If
If Mid$(Desc.Text, k, 1) = "-" Then
dem = dem + 1
Ddem.Text = dem
End If
If Mid$(Desc.Text, k, 1) = "0" Then
Damp.Text = 0
End If
Next k
End Sub

Private Sub Desc_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dchar.Text = Desc.TextLength - 1
End Sub

Private Sub Desc_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dchar.Text = Desc.TextLength + 1
End Sub

'Keywords Code
Private Sub Keyword_Change()
l3 = Len(Keyword.Text)
If l3 >= 300 Then
MsgBox "Keywords Exceeded the Maximum Length"
End If
If l3 = 0 Then
Kcommos.Text = 0
Kamp.Text = 0
Kpipe.Text = 0
Kdem = 0
Kdots = 0
End If
For i = 1 To l3
If Mid$(Keyword.Text, i, 1) = "," Then
commas = commas + 1
Kcommos.Text = commas
End If
Next i
For m = 1 To l3
If Mid$(Keyword.Text, m, 1) = "&" Then
amp = amp + 1
Kamp.Text = amp
End If
If Mid$(Keyword.Text, m, 1) = "0" Then
Kamp.Text = 0
End If
If Mid$(Keyword.Text, m, 1) = "|" Then
pipe = pipe + 1
Kpipe.Text = pipe
End If
If Mid$(Keyword.Text, m, 1) = "." Then
dots = dots + 1
Kdots.Text = dots
End If
If Mid$(Keyword.Text, m, 1) = "-" Then
dem = dem + 1
Kdem.Text = dem
End If
Next m
End Sub

Private Sub Keyword_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Kchar.Text = Keyword.TextLength - 1
End Sub

Private Sub Keyword_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Kchar.Text = Keyword.TextLength + 1
End Sub
Dim tp As Integer
Dim str, flt(), strflt, sflt As String
Dim l, l1, l2, l3, i, j, t As Integer

'Title code
Private Sub Title_Change()
Dim commas As Integer
Dim pos As Integer
Dim str As String
l = Len(Title.Text)
If l >= 80 Then
MsgBox "Title Exceeded the Maximum Length"
End If

If l = 0 Then
Tchar = 0
Tcommos.Text = 0
Tamp.Text = 0
Tpipe.Text = 0
Tdem = 0
Tdots = 0
End If

For j = 1 To l
If Mid$(Title.Text, j, 1) = "," Then
commas = commas + 1
Tcommos.Text = commas
End If
If Mid$(Title.Text, j, 1) = "&" Then
amp = amp + 1
Tamp.Text = amp
End If
If Mid$(Title.Text, j, 1) = "|" Then
pipe = pipe + 1
Tpipe.Text = pipe
End If
If Mid$(Title.Text, j, 1) = "0" Then
Tamp.Text = 0
End If
If Mid$(Title.Text, j, 1) = "." Then
dots = dots + 1
Tdots.Text = dots
End If
If Mid$(Title.Text, j, 1) = "-" Then
dem = dem + 1
Tdem.Text = dem
End If
Next j
End Sub
Private Sub Title_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Tchar.Text = Title.TextLength - 1

End Sub
Private Sub Title_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Tchar.Text = Title.TextLength + 1
End Sub

'Description Code
Private Sub Desc_Change()
l1 = Len(Desc.Text)
If l1 >= 200 Then
MsgBox "Description Exceeded the Maximum Length"
End If
If l1 = 0 Then
Dcommos.Text = 0
Damp.Text = 0
Dpipe.Text = 0
Ddots.Text = 0
Ddem.Text = 0
Dchar.Text = 0
End If
For i = 1 To l1
If Mid$(Desc.Text, i, 1) = "," Then
commas = commas + 1
Dcommos.Text = commas
End If
Next i
For k = 1 To l1
If Mid$(Desc.Text, k, 1) = "&" Then
amp = amp + 1
Damp.Text = amp
End If
If Mid$(Desc.Text, k, 1) = "|" Then
pipe = pipe + 1
Dpipe.Text = pipe
End If
If Mid$(Desc.Text, k, 1) = "." Then
dots = dots + 1
Ddots.Text = dots
End If
If Mid$(Desc.Text, k, 1) = "-" Then
dem = dem + 1
Ddem.Text = dem
End If
If Mid$(Desc.Text, k, 1) = "0" Then
Damp.Text = 0
End If
Next k
End Sub

Private Sub Desc_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dchar.Text = Desc.TextLength - 1
End Sub

Private Sub Desc_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dchar.Text = Desc.TextLength + 1
End Sub

'Keywords Code
Private Sub Keyword_Change()
l3 = Len(Keyword.Text)
If l3 >= 300 Then
MsgBox "Keywords Exceeded the Maximum Length"
End If
If l3 = 0 Then
Kcommos.Text = 0
Kamp.Text = 0
Kpipe.Text = 0
Kdem = 0
Kdots = 0
End If
For i = 1 To l3
If Mid$(Keyword.Text, i, 1) = "," Then
commas = commas + 1
Kcommos.Text = commas
End If
Next i
For m = 1 To l3
If Mid$(Keyword.Text, m, 1) = "&" Then
amp = amp + 1
Kamp.Text = amp
End If
If Mid$(Keyword.Text, m, 1) = "0" Then
Kamp.Text = 0
End If
If Mid$(Keyword.Text, m, 1) = "|" Then
pipe = pipe + 1
Kpipe.Text = pipe
End If
If Mid$(Keyword.Text, m, 1) = "." Then
dots = dots + 1
Kdots.Text = dots
End If
If Mid$(Keyword.Text, m, 1) = "-" Then
dem = dem + 1
Kdem.Text = dem
End If
Next m
End Sub

Private Sub Keyword_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Kchar.Text = Keyword.TextLength - 1
End Sub

Private Sub Keyword_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Kchar.Text = Keyword.TextLength + 1
End Sub

its a crap, its just a MS word document with some VB code in it.
It doesnt work well when compared to other tools for title and meta tags

Hi Athar. This code is useful for to count optimize the meta tags in SEO process. We can easily count number of characters used and create alert for illegal characters that are not useful for our website. \
I think it will be useful for some concern for their project work.

by
Hari..

Here i have created new tool for SEO optimization using Microsoft Word. Using these tools we can count number of characters used for title, description and keywords tag, number of delimiters symbols used in title tag and also the commas, dots also can be used to find from these tools. we can also find set the limits for the title, description and keywords tag.

Dim tp As Integer
Dim str, flt(), strflt, sflt As String
Dim l, l1, l2, l3, i, j, t As Integer

'Title code
Private Sub Title_Change()
Dim commas As Integer
Dim pos As Integer
Dim str As String
l = Len(Title.Text)
If l >= 80 Then
MsgBox "Title Exceeded the Maximum Length"
End If

If l = 0 Then
Tchar = 0
Tcommos.Text = 0
Tamp.Text = 0
Tpipe.Text = 0
Tdem = 0
Tdots = 0
End If

For j = 1 To l
If Mid$(Title.Text, j, 1) = "," Then
commas = commas + 1
Tcommos.Text = commas
End If
If Mid$(Title.Text, j, 1) = "&" Then
amp = amp + 1
Tamp.Text = amp
End If
If Mid$(Title.Text, j, 1) = "|" Then
pipe = pipe + 1
Tpipe.Text = pipe
End If
If Mid$(Title.Text, j, 1) = "0" Then
Tamp.Text = 0
End If
If Mid$(Title.Text, j, 1) = "." Then
dots = dots + 1
Tdots.Text = dots
End If
If Mid$(Title.Text, j, 1) = "-" Then
dem = dem + 1
Tdem.Text = dem
End If
Next j
End Sub
Private Sub Title_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Tchar.Text = Title.TextLength - 1

End Sub
Private Sub Title_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Tchar.Text = Title.TextLength + 1
End Sub

'Description Code
Private Sub Desc_Change()
l1 = Len(Desc.Text)
If l1 >= 200 Then
MsgBox "Description Exceeded the Maximum Length"
End If
If l1 = 0 Then
Dcommos.Text = 0
Damp.Text = 0
Dpipe.Text = 0
Ddots.Text = 0
Ddem.Text = 0
Dchar.Text = 0
End If
For i = 1 To l1
If Mid$(Desc.Text, i, 1) = "," Then
commas = commas + 1
Dcommos.Text = commas
End If
Next i
For k = 1 To l1
If Mid$(Desc.Text, k, 1) = "&" Then
amp = amp + 1
Damp.Text = amp
End If
If Mid$(Desc.Text, k, 1) = "|" Then
pipe = pipe + 1
Dpipe.Text = pipe
End If
If Mid$(Desc.Text, k, 1) = "." Then
dots = dots + 1
Ddots.Text = dots
End If
If Mid$(Desc.Text, k, 1) = "-" Then
dem = dem + 1
Ddem.Text = dem
End If
If Mid$(Desc.Text, k, 1) = "0" Then
Damp.Text = 0
End If
Next k
End Sub

Private Sub Desc_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dchar.Text = Desc.TextLength - 1
End Sub

Private Sub Desc_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dchar.Text = Desc.TextLength + 1
End Sub

'Keywords Code
Private Sub Keyword_Change()
l3 = Len(Keyword.Text)
If l3 >= 300 Then
MsgBox "Keywords Exceeded the Maximum Length"
End If
If l3 = 0 Then
Kcommos.Text = 0
Kamp.Text = 0
Kpipe.Text = 0
Kdem = 0
Kdots = 0
End If
For i = 1 To l3
If Mid$(Keyword.Text, i, 1) = "," Then
commas = commas + 1
Kcommos.Text = commas
End If
Next i
For m = 1 To l3
If Mid$(Keyword.Text, m, 1) = "&" Then
amp = amp + 1
Kamp.Text = amp
End If
If Mid$(Keyword.Text, m, 1) = "0" Then
Kamp.Text = 0
End If
If Mid$(Keyword.Text, m, 1) = "|" Then
pipe = pipe + 1
Kpipe.Text = pipe
End If
If Mid$(Keyword.Text, m, 1) = "." Then
dots = dots + 1
Kdots.Text = dots
End If
If Mid$(Keyword.Text, m, 1) = "-" Then
dem = dem + 1
Kdem.Text = dem
End If
Next m
End Sub

Private Sub Keyword_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Kchar.Text = Keyword.TextLength - 1
End Sub

Private Sub Keyword_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Kchar.Text = Keyword.TextLength + 1
End Sub
Attachments SEO_tools.jpg 19.2 KB