need to edit and add vb code to excel sheet

shrinivasmj

Board Regular
Joined
Aug 29, 2012
Messages
140
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
 

Forum statistics

Threads
1,082,037
Messages
5,362,793
Members
400,693
Latest member
jenlj

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top