supergrass71

Keybase proof

I hereby claim:

• I am supergrass71 on github.
• I am mjn (https://keybase.io/mjn) on keybase.
• I have a public key ASBgpJ6qJIkK8yqkhT17HjieFEyIRBdF2gNc2936LVcd3Qo

To claim this, I am signing this object:

supergrass71

Attribute VB_Name = "Document_Cleanse"
Option Explicit

Sub LoopFolder()

'from https://www.mrexcel.com/forum/excel-questions/866125-vba-loop-through-all-files-all-subfolders.html
    Dim fso As New FileSystemObject
    Dim f As Folder, sf As Folder
    Dim ofile As File
    Dim MyPath As String, RootFolder As String

supergrass71

Sub createNewStepsWorksheet()

Dim totalSheets As Integer
Dim sheetName As String

sheetName = ActiveCell.Value

With ActiveWorkbook
    totalSheets = .Worksheets.Count
    .Sheets(2).Copy After:=Sheets(totalSheets)

supergrass71

Sub AddValidation(cell as range)
'designed to work in tandem with worksheet function (see next)
If cell.rows.count>1 or cell.columns.count>1 then exit sub

With cell.validation
	.delete
    .add Type:=xlValidateList, AlertStyle:=xlValidateAlertStop, Operator: _
    	xlBetween, Formula:="A,list,of,your,values"
    .ignoreblank = True
    .incelldropdown = true

supergrass71

Sub RemoveHlinks()
    'https://www.extendoffice.com/documents/excel/2221-excel-remove-hyperlink-without-removing-formatting.html
    'Update 20180220 special sauce from Murray Neish
    Dim Rng As Range
    Dim WorkRng As Range
    Dim TempRng As Range
    Dim UsedRng As Range
    Dim xLink As Hyperlink
    Dim xTitleId As String

supergrass71

Sub MakeSquareCells()
'// Create graph paper in Excel see http://www.erlandsendata.no/english/index.php?d=envbawssetrowcol
'if you want cm or inches
Dim noOfColumns As Integer, squareSide As Integer, i As Integer
noOfColumns = Application.InputBox(Prompt:="Select number of columns for grid (from column A:)", _
	Title:="Square Grid Maker", Default:=1, Type:=1)
squareSide = Application.InputBox(Prompt:="Select width (mm:", _
	Title:="Square Grid Maker", Default:=1, Type:=1)
Application.ScreenUpdating = False
With Activesheet

supergrass71

Public Sub FindReplaceAnywhere() 'https://wordmvp.com/FAQs/Customization/ReplaceAnywhere.htm Dim rngStory As Word.Range Dim pFindTxt As String Dim pReplaceTxt As String Dim lngJunk As Long Dim oShp As Shape
pFindTxt = InputBox("Enter the text that you want to find.", "FIND")
If pFindTxt = "" Then
MsgBox "Cancelled by User"
Exit Sub
End If
TryAgain: pReplaceTxt = InputBox("Enter the replacement.", "REPLACE")
If pReplaceTxt = "" Then
    If MsgBox("Do you just want to delete the found text?", vbYesNoCancel) = vbNo Then
        GoTo TryAgain

supergrass71

Sub addScreenTip(doc As Document, rng As Range, bmark As String, tip As String)
'add bookmark
With doc.Bookmarks
    .Add Range:=Selection.Range, Name:=bmark
    .DefaultSorting = wdSortByName
    .ShowHidden = False
End With
 
End Sub

supergrass71

Function CleanTrim(ByVal S As String, Optional ConvertNonBreakingSpace As Boolean = True) As String
'https://www.mrexcel.com/forum/excel-questions/923725-vba-remove-all-non-printable-special-characters-well-trim.html
  Dim X As Long, CodesToClean As Variant
  CodesToClean = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, _
                       21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 127, 129, 141, 143, 144, 157)
  If ConvertNonBreakingSpace Then S = Replace(S, Chr(160), " ")
  For X = LBound(CodesToClean) To UBound(CodesToClean)
    If InStr(S, Chr(CodesToClean(X))) Then S = Replace(S, Chr(CodesToClean(X)), "")
  Next
  CleanTrim = S

supergrass71

Sub createNote2()
'based on https://wordribbon.tips.net/T013230_ScreenTips_without_Hyperlinks
'uses acronym module instead of user inputbox
Dim timeStamp As String, bookmarkName As String, screentipText As String, key As String
Dim rng As Range
Dim answer As Integer
Dim tbl As Table
Application.ScreenUpdating = False
timeStamp = Format(Now(), "yyyyMMddHHmmss")
'On Error GoTo ErrHandler