Category: Demo

How to TRIM() cr/lf?

What about TRIM() for removing white space from strings!
Although it is a really handy BUG-ELIMINATOR for whenever a user pastes 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 http://excel-on-demand.com/2017/01/25/vbcommon-chomp-nibble/

VBS – time stamp: options demo

VBS will run in Windows as a stand alone script just like JS (JavaScript) and BATCH files.

'save as ANSI TXT file with extenstion ".vbs" 
'saving as UTF and Unicode will show "Error in Line 1"
nowis = Now
msgbox minuteStamp, vbOKOnly,"MinuteStamp"
msgbox timeStamp, vbOKOnly, "TimeStamp"
msgbox timestamphhmmss(nowis), vbOKOnly, "Time Stamp hh mm ss"

' ==== 'right' forces two digit values ===
Function minuteStamp() 
 minuteStamp = Year(Now) & "_" & _
 Right("0" & Month(Now),2) & "_" & _
 Right("0" & Day(Now),2) & "_" & _ 
 Right("0" & Hour(Now),2) & _
 Right("0" & Minute(Now),2) 
 '& _ Right("0" & Second(Now),2) 
End Function

' ============
Function timeStamp()
 timeStamp = Year(Now) & "_" & _
 Right("0" & Month(Now),2) & "_" & _
 Right("0" & Day(Now),2) & "_" & _ 
 Right("0" & Hour(Now),2) & _
 Right("0" & Minute(Now),2) & _
 Right("0" & Second(Now),2) 
End Function
' ======


Function timestamphhmmss(someTime)
 timestamphhmmss = FormatDateTime(someTime,vbshorttime) & ":" & right("0" & Second(someTime), 2)
End Function
 
'Constant Value Description from Microsoft® HELP
'vbGeneralDate 0 Display a date and/or time. If there is a date part, display it as a short date. If there is a time part, display it as a long time. If present, both parts are displayed.
' vbLongDate 1 Display a date using the long date format specified in your computer's regional settings.
' vbShortDate 2 Display a date using the short date format specified in your computer's regional settings.
' vbLongTime 3 Display a time using the time format specified in your computer's regional settings.
' vbShortTime 4 Display a time using the 24-hour format (hh:mm).
'_______________________________

 

AHK Macro: Show NumLock, Insert

Is your LAPTOP  keyboard MISSING the STATUS INDICATOR for Insert , CapsLock or NumLock keys?

*IF* your computer once had but LOST this feature, it will be EASIER for you to reinstall from your OEM's website or the installation disk that *may* have come with your computer.

Otherwise this will help!  Requires installing AHK.

; AHK script - a great PLAN B if your laptop is missing this feature AND not available from the OEM download page

~CapsLock:: ; Show CapsLock state on screen
 if GetKeyState("CapsLock", "T")
 Progress, B1 W200 H28 ZH0 FS11 WS900 Y700 CTFF0000, CAPS LOCK ON
 else
 Progress, B1 W200 H28 ZH0 FS11 WS900 Y700 CT0000FF, CAPS LOCK OFF
 SetTimer, OSD_OFF, -2000
 return

~NumLock:: ; Show NumLock state on screen
 if GetKeyState("NumLock", "T")
 Progress, B1 W200 H28 ZH0 FS11 WS900 Y700 CT00FF00, NUM LOCK ON
 else
 Progress, B1 W200 H28 ZH0 FS11 WS900 Y700 CTFF0000, NUM LOCK OFF
 SetTimer, OSD_OFF, -2000
 return

~Insert:: ; Show Insert state on screen
 if GetKeyState("Insert", "T")

 Progress, B1 W200 H28 ZH0 FS11 WS900 Y700 CTE60316, OVERWRITE MODE
else
 Progress, B1 W200 H28 ZH0 FS11 WS900 Y700 CT007800, INSERT MODE
 SetTimer, OSD_OFF, -2000
 return

OSD_OFF:
 Progress, off
 return

;https://autohotkey.com/board/topic/67080-display-capslock-state-helpful-for-vim/?hl=numlock+state#entry457616
 ; https://autohotkey.com/docs/KeyList.htm

Other AHK resources:

Install AutoHotKey for Windows
AHK Tutorial
Setup Notepad++ for AutoHotkey

 

 

Excel Macro Autonumber NonBlanks

Sub NumbernonBlankTestLines()
' user must manually highlight range in Column A
Dim msgs, qy, rep
Dim testcount, r, c As Integer,
Dim startHere As Range, rngSelected As Range
Dim markblank, enforcesinglerowblank As Boolean
enforcesinglerowblank = False

' MsgBox "last cell is " & findlastusedcell()
' use if we add feature to insert column A and auto-select range

testcount = 0

Set startHere = ActiveCell
Set rngSelected = Selection

If TypeName(Selection) = "Range" Then
If Selection.Areas.Count = 1 Then
' MsgBox "selected rows is " & rngSelected.Rows.Count & vbCrLf & "columnn is " & ActiveCell.Column

If rngSelected.Rows.Count < 2 Or ActiveCell.Column <> 1 Then GoTo oops

' magic starts here
'Selection.Name = "eraseme"
markblank = False
'MsgBox rngSelected.Rows.Count

If WorksheetFunction.CountA(rngSelected) > 1 Then
qy = MsgBox("OVERWRITE existing DATA?", vbOKCancel, "WARNING!")
If qy = vbCancel Then
Exit Sub
Else
rngSelected.ClearContents
End If
'WorksheetFunction.CountA(rngSelected)
End If
For r = 1 To rngSelected.Rows.Count

rngSelected(r).Activate

If r = 1 Then
If rngSelected(r).Offset(0, 1) = "" Then
MsgBox rngSelected(r).Offset(0, 1).Value
GoTo oops
End If
End If

'case not blank
If rngSelected(r).Offset(0, 1) > "" Then
If enforcesinglerowblank And markblank Then
GoTo doublelineerror
ElseIf Not markblank Or Not enforcesinglerowblank Then
markblank = Not markblank
rngSelected(r).Value = testcount + 1
' markblank = False Else markblank = True
testcount = testcount + 1
End If
'case blank
ElseIf rngSelected(r).Offset(0, 1) = "" Then
If enforcesinglerowblank And Not markblank Then
GoTo doublelineerror
ElseIf markblank Then
markblank = Not markblank
End If
Else: MsgBox "Unknown", vbCritical, "Error!"

End If

Next r
' GoTo A1
MsgBox "Numbered " & testcount & " rows"
'measure column B begin and end
'make temporary range from A2: to match B begin to B end

'tbd select column A
'if selection < 2 rows warn and exit
'for each row in A, test adjacent cell B has value - number A, set flag notblank
'if flag notblank then next row should be blank, else warn andexit else skip to next
'if flag notblank, then next row should NOT be blank, else warn and exit, else number A
Else
MsgBox "Please select only one area.", vbInformation
End If
End If
Exit Sub

doublelineerror:
MsgBox "Only one row per test, MUST be separated by exactly one blank row: see Test# " & testcount, vbCritical, "Halted / Config Error"

Exit Sub

oops:
MsgBox "HALTED: must select multiple continuous rows within column A, alongside alternating data in column B" & vbCrLf _
& "and first selected row is NOT blank", vbCritical, "SELECTION ERROR"

End Sub

Auto Metrics Chart Demo

Sample Chart Demo

auto progress chart
auto progress chart sample
The working, customizeable chart demonstrates "automatic metrics" - it gives you timely reporting with just a quick attachment or a screenshot from the current Test XLS Suite being executed.

click chart thumbnail at right for full screenshot. Download XLS from link[s] above. Downloading from Google will require (a) having and (b) signing in to a Google account.

The Sample Test Suite in left columns will automatically tabulate the
progress summmary and chart on the right. This is done without
pivot tables, to give more flexibility and less maintenance.The benefit is for both individuals AND teams to be able to report whenever asked yet with minimal interruption.