need to edit and add vb code to excel sheet

[shrinivasmj]

hi


please use the version1.7 to add the vb formula in it.


in modmain vb script


hi

i need to add a vb code in by vb script below

eg-

1.data is in c1 out put to c3.,after first 2 digits the following 4 digits

c3 =mid(c1,2,4)

2. data in c9, and c16 ,“open and Closed inverted Commas" if no data found ,dont add inverted Commas

3.data in c10, ^is space input (09/10/1990), out put as - 09th ^ October,^^1990)

4.data in c19 = input 16 months out put - 1 Years, 4 Months.



code below

'Formatting Part Start here
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'1 Leave no space in Hypen COMMON

Columns("C:C").Replace " - ", "-", xlPart
Columns("C:C").Replace "- ", "-", xlPart
Columns("C:C").Replace " -", "-", xlPart
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'2 After comma (, ) put double space (^^) wherever it appears
'Range("C1:C10, C13:C14, C17:C18, C23:C22, C25:C40").Replace ",", ", ", xlPart
'Changed as per Sri req on 21 Dec 2013
Range("C1:C5, C7:C8, C10:C16, C20:C22, C25:C25, C27:C40").Replace ",", ", ", xlPart

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'3 Don't Leave any Space in Company Code Brackets ().
Range("C3").Replace " ", "", xlPart

'3.A Company Code: <B>{matter)<B> ' C3
If Range("C3") <> "" Then
Range("C3").Value = "<B>" & Range("C3").Value & "<B>"
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'4 Company Name: <R>(matter)<R>
cnt = 0
cnt1 = 0
If Range("C2") <> "" Then
'For geting code value
cnt = Len(Range("c2").Value)
cnt1 = InStrRev(Range("C2").Value, "-", Len(Range("c2").Value))

'Store fund name from Company Name
If cnt1 > 0 Then
Range("C28").Value = Right(Range("C2").Value, cnt - cnt1)
End If

Range("C2").Value = Left(Range("C2").Value, cnt1 - 1)
Range("C2").Value = "<R>" & Range("C2").Value & "<R>"
Range("C2").Replace ") ", ")", xlPart 'After 1st Review
Range("C2").Replace ") ", ")", xlPart 'After 1st Review
Range("C2").Replace ") ", ")", xlPart 'After 1st Review

End If


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'5 Type Full Form of Listing date as shown on Image Data
'Type Full Form of Listing date as shown on Image Data. (Eg. 5/10/2008 or 5 Oct 2008 Ans: 05th October, ^^2008).
Range("C10").TextToColumns Destination:=Range("C10"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
Range("D10").FormulaR1C1 = "=TEXT(RC[-1],""d"")&LOOKUP(DAY(RC[-1]),{1,2,3,4,21,22,23,24,31;""st"",""nd"",""rd"",""th"",""st"",""nd"",""rd"",""th"",""st""})&TEXT(RC[-1],"" mmmm, yyyy"")"
Range("C10").Value = Range("D6").Value


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'6 Leave No Space (^) & Don't Add Full Forms in Website name.
'Here C9 is from my check file
Range("C14").Replace " ", "", xlPart
'Company Website: <I><U>(matter)
If Range("C14") <> "" Then
Range("C14").Value = "<I><U>" & Range("C14").Value
End If


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'7 Authorised Shares: <R><B>( matter)
If Range("C16") <> "" Then
Range("C16").Value = "<R><B>" & Range("C16").Value
End If


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'7 Authorised Shares: <R><B>( matter)
If Range("C16") <> "" Then
Range("C16").Value = "<R><B>" & Range("C16").Value
End If


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'8 Market Capital: <R>(matter)<R>
If Range("C11") <> "" Then
Range("C11").Value = "<R>" & Range("C11").Value & "<R>"
End If


'9 Only in Company's Profile anywhere after full stop (. ) use double space (^^) (Not in the End).
' Range("C4").Replace ".", ". ", xlPart
Range("D4").FormulaR1C1 = "=IF(RC[-1]="""","""",IF(RIGHT(RC[-1],1)="" "",LEFT(RC[-1],LEN(RC[-1])-1),RC[-1]))"
Range("C4").Value = Range("D4").Value
'Find and replace shortcut with fullform After 2nd Review

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'10 Clear D Columns data COMMON
Range("D:D").ClearContents
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'11 NOT MENTIONED
For Each cell In Range("C1:C30")
If IsEmpty(cell) Or cell.Value = "" Then
If cell.Address = "$C$2" Then
cell.Value = "<R>Not Mentioned<R>"
ElseIf cell.Address = "$C$3" Then
cell.Value = "<B>Not Mentioned<B>"
ElseIf cell.Address = "$C$14" Then
cell.Value = "<I><U>Not Mentioned"
ElseIf cell.Address = "$C$16" Then
cell.Value = "<R><B>Not Mentioned"
ElseIf cell.Address = "$C$11" Then
cell.Value = "<R>Not Mentioned<R>"
Else
cell.Value = "<B>Not Mentioned<B>"
End If
Else
i = 1
Do
If oldstr(i) <> "" Then
If cell.Address = "$C$9" Then
Else
cell.Replace oldstr(i), newstr(i), xlPart
End If
Else
Exit Do
End If
i = i + 1
Loop
End If
Next
Range("C17").Replace ".", ". ", xlPart
Range("C17").Replace ". ", ". ", xlPart
Columns("C:C").Replace ", ", ", ", xlPart
For i = 128 To 255
Columns("C:C").Replace Chr(i), "", xlPart
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set rng = Nothing 'Sheets("Data").Range("B:B")
End With
Application.DisplayAlerts = False
'Sheets(sht).Delete
Workbooks(obj_file.Name).Close savechanges:=True, FileName:=fldr1 & "\" & obj_file.Name
' If inum >= 50 Then
' msg = "Using Demo File limit to 50 file per click, please contact " & EMC & " For Complete file"
' Workbooks(fName).Close savechanges:=False
' ws.Activate
' ws.Cells.Columns.AutoFit
' GoTo endprg
' End If
step1:
Next
'-----------------------------
Workbooks(fName).Close savechanges:=False
ws.Activate
ws.Cells.Columns.AutoFit
msg = "Finish"
endprg:
Set rng = Nothing
MsgBox msg, vbInformation, EMC
append
End Function