I need to add a "padding-bottom" to a cell in VBA.
A way to get what I need might be to append to a cell a char with smaller font size (let's say a small dot) in a new line.
How can I achieve this in VBA?
The following will insert "my text" into range A1, you can adapt it as you need.
It works as follows:
Get the current number of characters in Range A1 (lOldTextLen)
Insert two line breaks and "my text" into Range A1
Update the characters in Range A1 to font size 8, starting from the end of the previous text (using lOldTextLen)
Dim sText As String
Dim lOldTextLen As Long
sText = "my text"
lOldTextLen = Len(Range("a1"))
Range("a1").Value = Range("a1").Value & vbNewLine & vbNewLine & sText
Range("a1").Characters(lOldTextLen + 1).Font.Size = 8
Related
I am fairly new to the VBA world. I was wondering if there is any way that you could use underline, bold and Italic in a single cell. In this example, I would like just the first and second line to be bold, with the name coming 2 hyphens after the first word, and the third line underline. Not entirely sure if this is possible. The first cell shows what I have. The second cell shows what I'm looking for.
If you want to perform this on several cells then you can use below code as a starting point. I have provided comments in the code which should assist you to understand.
Public Sub HUBSpecificStyle()
Dim rng As Range
Dim varContent, varFirstRow
'\\Loop through all cells in selection
For Each rng In Range("A2:B2") '\\ Set your range reference here
varContent = Split(rng.Value, Chr(10)) '\\ Split cell contents by newline character
With rng
'\\ First two lines of row bold
.Characters(1, Len(varContent(0) & Chr(10) & varContent(1))).Font.Bold = True
'\\Third line underline
.Characters(Len(varContent(0) & Chr(10) & varContent(1) & Chr(10)) + 1, Len(varContent(2))).Font.Underline = True
'\\ Split first line with hyphens
varFirstRow = Split(varContent(0), "-")
'\\Third part italic
.Characters(Len(varFirstRow(0) & "-" & varFirstRow(1) & "-") + 1, Len(varFirstRow(2))).Font.Italic = True
End With
Next rng
End Sub
I used another answer on SO to be able to convert an HTML string to displayed rich text in excel.
However, it comes with a nasty side effect of not being able to add data for multiple lines in a single cell (recommendation I found was to remove the paste logic).
Ideally, I'd like to NOT use the CreateObject for Internet Explorer in my solution, and just get the paste to work properly.
Here's the code that is found using a dictionary that does the paste to each cell.
How do I accomplish both the conversion of an HTML string to text AND paste multiple lines to a single cell?
' Sort By Years Descending
Dim yearKey As Variant
Dim firstYear As Boolean
Dim cellData As String
firstYear = True
cellData = "<HTML><DIV>"
For Each yearKey In stakeholderEvents(stakeholder).Keys
If Not firstYear Then
cellData = cellData & "<DIV></DIV>" ' Add Extra Blank Line
End If
cellData = cellData & "<B>" & yearKey & "</B>" & "<UL>" ' Add Year
' Loop Through Events For Year
Dim eventItem As Variant
For Each eventItem In stakeholderEvents(stakeholder)(yearKey)
cellData = cellData & "<LI>" & eventItem & "</LI>"
Next
cellData = cellData & "</UL>"
firstYear = False
Next
cellData = cellData & "<DIV></BODY></HTML>"
Set clipboardData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
clipboardData.SetText cellData
clipboardData.PutInClipboard
Sheet1.Activate
'Sheet1.Range (Sheet1.Cells(rowIndex, stakeholderEventsColumn).Address)
Sheet1.Cells(rowIndex, stakeholderEventsColumn).Select
'Sheet1.Cells(rowIndex, stakeholderEventsColumn).Select
Sheet1.PasteSpecial Format:="Unicode Text"
HTML alternative (reference Excel-friendly html: keeping a list inside a single cell) :
Set clipboardData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
clipboardData.SetText "<table><style>br {mso-data-placement:same-cell}</style><tr><td>" _
& "<b>Line 1</b><br>Line 2<br>Line 3"
clipboardData.PutInClipboard
Sheet1.Range("b2").PasteSpecial
XML alternative (the XML can be adjusted by analyzing the .Value(11) of a formatted cell) :
Dim c As Range
Set c = Sheet1.Range("b2")
c.Value = vbLf
c.Value(11) = Replace(c.Value(11), "<Data ss:Type=""String"">
</Data>", _
"<ss:Data ss:Type=""String"" xmlns=""http://www.w3.org/TR/REC-html40"">" & _
"<B>Line 1</B>
Line 2
Line 3</ss:Data>")
I think the problem is that you're using HTML for formatting, and Excel is always going to paste the HTML so that block-level elements go into different cells.
Another approach would be to use Excel's built-in formatting instead of using HTML tags. This will also let you eschew using the Clipboard object. Here's an example of adding some text to a range, and then formatting some of the text differently (i.e. bolding):
Public Sub PopulateHtmlData()
Dim cell As Excel.Range
Dim s1 As String, s2 As String
s1 = "Item 1"
s2 = "Item 2"
Set cell = Excel.Range("$A$1")
' use Chr(10) to add a new line in the cell
cell.Value = s1 & Chr(10) & s2
cell.Characters(0, Len(s1) - 1).Font.Bold = True
End Sub
I have below text in Excel cell:
$abcd.$efghijk.$lmn.$op.$qrst.
I want above text in following format in Excel cell using Excel formula only:
abcd$abcd.efghijk$efghijk.lmn$lmn.op$op.qrst$qrst.
Here's what I will suggest based on discussion.
In a general module, insert following code.
Public Function RepeatCustom(strInput As String) As String
Dim varInput As Variant
Dim i As Long
If Len(strInput) = 0 Then
RepeatCustom = ""
Else
varInput = Split(strInput, ".")
For i = LBound(varInput) To UBound(varInput)
RepeatCustom = RepeatCustom & " " & Mid(varInput(i), 2, Len(varInput(i))) & varInput(i)
Next
RepeatCustom = Replace(Trim(RepeatCustom), " ", ".") & "."
End If
End Function
And then assuming cell containing original data is A2, you can use above UDF:
=RepeatCustom(A2)
Just note that the code is minimum and is based on sample posted.
I am using a vba code in outlook to export some text from an email body into the next available row in excel. I am also exporting an array formula in the cell next door, so In this instance intRow4 as an integer represents the next available row on my worksheet.
And In this example my next available row is row 34. So we are exporting the description text from our email into cell (D34) in excel and are also inserting an array formula from outlook into excel, cell (E34). The formula is an index lookup formula that references D34 and should lookup the first 5 letters of a word and match it with a 3 letter code from another worksheet.
So on my other worksheet (worksheet 2) I have a list of data in columns
Description Other Other Other Other Code
Hotels NFP
Catering PLQ
Travel LMC
so where my email contains a description text like Catering then this will be exported into my excel cell (D34) and the formula which gets inserted into (E34) should find the corresponding description by referencing cell (D34) and matching it to the description in my column on sheet 2. This should then produce the 3 letter code in column 6. In this case it would be PLQ
My Description text in my email looks like:
Description of Provisional Supplier:
Catering
My export code seems to work fine and cell D34 gets populated with the description text from my email. And the formula gets inserted as an array in cell E34.
The problem is my formula is not producing the 3 letter code, it is showing #NUM! error.
However if I go into my cell D34 and place my cursor to the left of the text and hit the backspace key and hit enter again then the formula produces the 3 letter code.
I am removing spaces and line breaks from my description string at the point when it gets exported into excel and I can not explain why this is happening.
can someone please show me where I am going wrong and show me how I can get this working without me having to manually go in and edit the contents of my cell. thanks
Const SHEET_NAME4 = "Statistics"
intRow4 As Integer, _
Set excWks4 = excWkb.Worksheets(SHEET_NAME4)
intRow4 = excWks4.UsedRange.Rows.Count + 1
Dim l As String
l = excWks4.Cells(intRow4, 4).Address
excWks4.Cells(intRow4, 5).FormulaArray = "=IF(ISERROR(INDEX('Up'!$A$1:$G$10004,SMALL(IF(LEFT('Up'!$B$1:$B$10004,5)=LEFT(" & l & ",5),ROW($B$1:$B$10004)),ROW(1:1)),6)),"""",INDEX('Up'!$A$1:$G$10004,SMALL(IF(LEFT('Up'!$B$1:$B$10004,5)=LEFT(" & l & ",5),ROW($B$1:$B$10004)),ROW(1:1)),6))"
Dim b7 As String
If TypeName(olkMsg) = "MailItem" Then
b7 = olkMsg.Body
Dim indexOfNameb4 As Integer
indexOfNameb4 = InStr(UCase(b7), UCase("Description of the provisional Supplier:"))
Dim indexOfNamec4 As Integer
indexOfNamec4 = InStr(UCase(b7), UCase("Current Status: "))
Dim finalStringb4 As String
Dim LResult3364 As String
Dim LResult33644 As String
finalStringb4 = Mid(b7, indexOfNameb4, indexOfNamec4 - indexOfNameb4)
LResult3364 = Replace(finalStringb4, "Description of the provisional Supplier:", "")
LResult33644 = Replace(LResult3364, Chr(10), "")
Dim TrimString As String
Dim TrimString2 As String
Dim TrimString3 As String
TrimString = Trim(LResult33644)
TrimString3 = Replace(TrimString, " ", "")
excWks4.Cells(intRow4, 4) = TrimString3
End If
My Excel cells are formatted as general format if this helps
Have you tried adding the line
excWks4.Cells(intRow4, 4) = Trim(excWks4.Cells(intRow4, 4))
after the line
l = excWks4.Cells(intRow4, 4).Address
Alternatively you could may be able to add the TRIM function to your long formula around all references to those cells.
I am trying to copy the nonblanks cells in my excel file to txt file. My data looks like:
1 2 3
1 2
1
1 2 3 4
So, if i select all and copy, txt file shows like the empty cells have data which is not something that i want.
I tried this:
Crtl+A
Go to special
Constants
Numbers
These commands selects the nonblank cells but I cannot copy them. Is there a way to copy them? I get:
That command cannot be used on multiple selections.
Thanks
If you got notepad++, you can use the regex find and replace to remove all the extra tabs at the end of a line.
Open the txt file in notepad++ and hit Ctrl+H.
In find, put:
\t+$
In replace, leave it blank.
Then check the radio button for the search mode from 'Normal' to 'Regular expression'. After that, hit 'Replace All' and this should be it.
Dim fso As FileSystemObject
Dim stream As TextStream
Dim str As String
Set fso = New FileSystemObject
Set stream = fso.CreateTextFile("c:\myTextFile.txt", True)
For i = 1 To 10
For Each cell In Range("A" & i & "F" & i)
If Not IsEmpty(cell) Then
str = str + cell.Text + " "
End If
Next cell
stream.writeline (str)
str = ""
Next i
stream.Close
End Sub
all you gotta do is change what you wanted separated by ( the " " at the end of the str line) and the range you want ( i = rows 1 through 10 as is) and ("a" & i ":f" & i which indicates a through f, in this case for rows 1 through 10)
hope this helps
With Word as your text editor, copy Excel as is and Paste Special as Unformatted Text. Replace ^t^t with ^t until no more replacements are made, then ^t^p with ^p.