How to TRIM() cr/lf?

What about TRIM() for removing white space from strings!
Although it is a really handy BUG-ELIMINATOR for *IF* ever a user pastes rich text into your (MS-Access) application, STILL this attachment demonstrates that TRIM only works on outer spaces, not other white space characters like ASCII characters 9, 10, 12, 13. (vbTab, vbLf, Formfeed, vbCr)

' Save this in a VBS file on your desktop for a VISUAL DEMO comparing three string cleaning functions below
Dim someOtherString, someOtherString1, someOtherString2, someOtherString3
someOtherString1 = vbCrLf & vbTab & "Hi Mom!" & int(rnd(100)*5) & vbTab & vbCrLf
someOtherString2 = vbCrLf & vbTab & "Hi Mom!" & int(rnd(100)*5) & vbTab & vbCrLf
someOtherString3 = vbCrLf & vbTab & "Hi Mom!" & int(rnd(100)*5) & vbTab & vbCrLf
msgbox chr(34) & trim(someOtherString1) & chr(34),,"Trim"
msgbox chr(34) & nibble(someOtherString2) & chr(34),,"Nibble"
msgbox chr(34) & chomp(someOtherString3) & chr(34),,"Chomp"
' --------------------
Function chomp(somestring)
if len(somestring) >= 1 then
while (asc(right(somestring,1)) <= 13 )
somestring = left(somestring, len(somestring)-1)
wend
end if
chomp = somestring
End Function
' --------------------
Function nibble(somestring)
if len(somestring) >= 1 then
while (asc(left(somestring,1)) <= 13 )
somestring = right(somestring, len(somestring)-1)
wend
end if
nibble = somestring
End Function

See https://excel-on-demand.com/2017/01/25/vbcommon-chomp-nibble/

Print Unique Footer Header with Tabs

Problem:  You've been given  20 minutes to update 3 tabs of a 25 Tab *MONSTER* Spreadsheet, and REPORT your updates ....  Some are Landscape and some are Portrait.  Most are 5+ pages long.

How to make page number, sheet name and file name show in header and footer for your meeting in 20 minutes?

Sub Write_Header_Footer_from_Many_Tabbed_Workbook()
 Dim qystring, howmany, menudefault, sht
 'THIS IS FOR A XLS OF MANY TABS - sets the header, footer, and margins of each tab
 If Not ActiveWorkbook.Saved Then
 qystring = "nonemptystring"
 howmany = Sheets.Count
 Do
 menudefault = "OK to wait " & howmany * 10 & " seconds " ' Set default.
 qystring = InputBox("Wait 10 seconds each while header/footers written for " & howmany & " tabs?" _
 & vbCrLf & vbCrLf & "Enter Yes / No (or press 'Escape Key' to Skip)", "Enter Yes / No (or press 'Escape Key' to Skip)", menudefault)
 If qystring > "" Then qystring = UCase(Left(qystring, 1))
 'qystring = MsgBox(menudefault & " for " & howmany & " tabs?", vbYesNoCancel, "Write Tab Names to Header and Footer")
 Loop Until ((qystring = "N") Or (qystring = "Y") Or (qystring = "O") Or (qystring = ""))
 End If 'if not saved
 If UCase(Left(qystring, 1)) = "N" Then
 Exit Sub
' If qystring <> vbYes Then Exit Sub 'this line is if using msgbox alternative to inputbox above
 Else
 For Each sht In Sheets
 With sht.PageSetup
 .CenterHeader = "&A"
 .RightFooter = "Page &P of &N"
 .CenterFooter = "&08" & "&F" 'to show full (network) path use ' Me.Path & "/" & vbCrLf & "&F"
 .LeftFooter = "&D &T"
 .FitToPagesWide = 1
 .FitToPagesTall = 999
 .PrintTitleRows = "$1:$1"
 If (.Orientation = xlLandscape) Then
 .LeftMargin = Application.InchesToPoints(0.25)
 .RightMargin = Application.InchesToPoints(0.25)
 .TopMargin = Application.InchesToPoints(0.65)
 .BottomMargin = Application.InchesToPoints(0.65)
 .HeaderMargin = Application.InchesToPoints(0.2)
 .FooterMargin = Application.InchesToPoints(0.2)
 Else
 .LeftMargin = Application.InchesToPoints(0.5)
 .RightMargin = Application.InchesToPoints(0.5)
 .TopMargin = Application.InchesToPoints(0.5)
 .BottomMargin = Application.InchesToPoints(0.5)
 .HeaderMargin = Application.InchesToPoints(0.2)
 .FooterMargin = Application.InchesToPoints(0.2)
 End If
 End With
 Next sht
 End If ' vbyes
 
 End Sub
'--------------

Macro: datetimestamp()

Appends date/time stamp to current cell.

Sub datestamp()
Dim strWhatTime
 
 strWhatTime = Format(Now(), "mm-dd-yy hh:mm:ss ddd")
 If ActiveCell.Value = "" Then
 ActiveCell.Value = strWhatTime
 '& (tempp - Int(temp))
 'ActiveCell.Value = Format(Now(), "c") '& (tempp - Int(temp))
 Else
 ActiveCell.Value = ActiveCell.Value & " " & strWhatTime
 End If
 
End Sub
'ActiveCell.FormulaR1C1 = "11/1/2011"

Merge Cells with Zero Data Loss

This macro is best called by assigning it to a short-cut key-sequence, e.g. "Ctrl-Shift-M"(erge).  Do this in the Macro Edit dialog by the Excel short-cut sequence Alt-T-M-M (See SWF video - will run in most browsers: IE, Chrome, Firefox). It calls "nibble" which has it's own Post, but is also included below.

Sub mergeselection()
 Dim strTemp As String
 Dim youAreHere As Object
 Dim cc, k As Integer
 
 Set youAreHere = ActiveCell
' MsgBox ActiveCell.Address
' MsgBox Selection.Rows.Count
 
 
 For Each cc In Selection.Cells
 strTemp = strTemp & vbCrLf & cc.Value
 'strTemp = strTemp & vbCrLf & k + 1 & " " & cc.Value
 'k = k + 1
 Next cc
 With Selection  'With Selection is left over from macro recording
 .HorizontalAlignment = xlCenter
 .VerticalAlignment = xlBottom
 .WrapText = False
 .Orientation = 0
 .AddIndent = False
 .IndentLevel = 0
 .ShrinkToFit = False
 .ReadingOrder = xlContext
 ' .MergeCells = False
 End With
 Application.DisplayAlerts = False
 Selection.Merge
 Application.DisplayAlerts = True
 strTemp = nibble(strTemp) '& vbCrLf
 
 With youAreHere
 youAreHere.Value = strTemp
 youAreHere.HorizontalAlignment = xlLeft
 youAreHere.VerticalAlignment = xlTop
 youAreHere.Activate
 End With
 
End Sub

' ===========================
Private Function nibble(somestring)
 'Dim islf
 If Len(somestring) >= 1 Then
 While (Asc(Left(somestring, 1)) <= 13) 'this will eat vbTab chr(9) !!!
 ' islf = asc(right(somestring,1))
 somestring = Right(somestring, Len(somestring) - 1)
 Wend
 End If
 nibble = somestring
End Function

 

Excel to the Horse Races

Download Excel to the Horse Races
A working demonstration of unit conversion between old and new methods.

In this case COMPARE same Horse in different TRACKS and CONDITIONS:
furlongs, meters, feet, yards!  (Screenshots and download links below).

Conversion Demonstration - furlongs, meters, yards, miles

BEST PRACTICE ALERT: TEST your default security
and SCAN BEFORE downloading ANY product with MACROs.
This can be handled by most modern anti-virus software (I use
Webroot) *AND* by setting your Excel, or Word Options | Trust settings to highest security.

Consumer bears full responsibility to scan for unexpected code errors, malware or viruses.

Excel macro worksheet (equus044b1.xlsm) (optional Active-X button and macro in first sheet to simplify default setting.)

Excel sheet ".xlsX" - no macro (button) (no local macro: ActiveX buttons only work in local tab: use a "form button" element to if you want to call a button handler from the local macro template in folder "XLStart")

Download