RyanDev.com

Download the full code.

---

Attribute VB_Name = “FindReplace”
Public Sub GlobalFindandReplace()
Dim oDoc As Word.Document
Dim oFile As File
Dim oFolder As Folder
Dim fs As FileSystemObject

Set fs = New FileSystemObject
Set oFolder = fs.GetFolder(”c:\ptr”) ‘the folder with all of the files

Application.DisplayAlerts = wdAlertsNone ‘don’t put up any prompts
For Each oFile In oFolder.Files ‘loop through all files in the folder
  If oFile.Type = “Microsoft Word Document” Then ‘only touch Word files
  Set oDoc = Application.Documents.Open(oFile.Path) ‘open the file
  ‘***********************
  ‘beginning of first find
  Selection.Find.ClearFormatting
  Selection.Find.Replacement.ClearFormatting
  With Selection.Find
  .text = “administrator”
  .Replacement.text = “Administrator”
  .Forward = True
  .Wrap = wdFindContinue
  .Format = False
  .MatchCase = True
  .MatchWholeWord = False
  .MatchByte = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchWildcards = False
  .MatchFuzzy = False
  .Execute Replace:=wdReplaceAll
  End With
  ‘end of first find
  ‘************************
  ‘if a second find is needed copy the above code here

‘end of second find

End If
  ’save and close the document
  oDoc.Save
  oDoc.Close
Next oFile ‘move on to the next file
Application.DisplayAlerts = wdAlertsAll ‘turn alerts back on
End Sub

---

Download the full code.

Download the full solution.

---

The code for this is below:Dim FirstSheet As IntegerPrivate Sub cmdCancel_Click()
Unload Me
Sheets(FirstSheet).Select
End
End Sub

Private Sub cmdOk_Click()
Dim Total As Double, SubTotal As Double
Dim i As Integer
Dim StartTime As Variant
StartTime = Now()
Me.MousePointer = fmMousePointerHourGlass
Total = 0

If optThis.Value = True Then
    On Error Resume Next
    Total = Selection.SpecialCells(xlCellTypeFormulas, 23).Count
End If
If optEntire.Value = True Then
    For i = 1 To ActiveWorkbook.Sheets.Count
        SubTotal = 0
        Sheets(i).Activate
        On Error Resume Next
        SubTotal = Selection.SpecialCells(xlCellTypeFormulas, 23).Count
        Total = Total + SubTotal
    Next i
End If
If optSelection.Value = True Then
    Dim SelRange As Range
    Dim address As String
    address = RefEdit1.Value
    Set SelRange = Range(address)
    On Error Resume Next
    Total = SelRange.SpecialCells(xlCellTypeFormulas, 23).Count
End If
Me.MousePointer = fmMousePointerDefault
If Total = 0 Then
    MsgBox “There were no formulas counted.” & vbCrLf & “Total time: ” & Format(Now() - StartTime, “h:m:ss”), , “Formula Count”
Else
    MsgBox “There were ” & Format(Total, “###,###,###”) & ” formulas counted.” & vbCrLf & “Total time: ” & Format(Now() - StartTime, “h:m:ss”), , “Formula Count”
End If
Sheets(FirstSheet).Select
End Sub

Private Sub optEntire_Click()
Frame2.Visible = False
End Sub

Private Sub optSelection_Click()
Frame2.Visible = True
Frame2.SetFocus
End Sub

Private Sub optThis_Click()
Frame2.Visible = False
End Sub

Private Sub UserForm_Initialize()
optThis.Value = True
FirstSheet = ActiveWorkbook.ActiveSheet.Index
End Sub

---

Download the full solution.

Here is some sample code that will document the formulas you have in your worksheet.  It will create a separate sheet named Formulas that will list all of the formulas being used.

---

Public Sub DocumentFormulas()
‘——————————————————————————————
‘Created by Ryan Brown
‘This is a sample that will document the formulas from the sheet that it is run on
‘It will create a sheet called Formulas and you will get an error if a sheet named formulas
‘already exists.
‘It will put both the cell address and the cell formula into 2 separate columns
‘——————————————————————————————
Dim SelRange As Range
Dim oCell As Object
Dim strSheet As String
Dim i As Integer

strSheet = ActiveSheet.Name

’store all of the formulas on the given sheet into a range variable
Set SelRange = Selection.SpecialCells(xlCellTypeFormulas, 23)

ActiveWorkbook.Sheets.Add
ActiveSheet.Name = “Formulas”

i = 1   ’start at cell A1

‘loop through each cell in the range of formulas and print the address and formula
For Each oCell In SelRange.Cells
    Sheets(”Formulas”).Cells(i, 1) = oCell.address
    Sheets(”Formulas”).Cells(i, 2).NumberFormat = “@”   ‘change cell format first to text so formula shows
    Sheets(”Formulas”).Cells(i, 2) = oCell.Formula
    i = i + 1
Next oCell
End Sub

---

Below is some sample code that I have used in the past that has some useful date and time functions.  The code was written in Visual Basic 6.0 but can easily be converted to .Net.

---

Attribute VB_Name = “TimeDateFunctions”
Public TheYear As Integer, TheMonth As Integer, TheDay As Integer

Public Function LastDayOfMonth(ByVal ADate As Date, PreviousMonth As Integer) As Integer ‘Previous month is an offset of the passed in date to return the last day in a different month

‘For example, if ADate is in February and PreviousMonth is 3, the last day of November will be given

‘This will not go back more than a year, previous month max is 12

Dim CurrentMonth As Integer, i As Integer

CurrentMonth = Month(ADate) - PreviousMonth

TheYear = Year(ADate)

If CurrentMonth <= 0 Then

CurrentMonth = 12 + CurrentMonth

TheYear = TheYear - 1

End If

TheMonth = CurrentMonth

Select Case CurrentMonth

Case 1, 3, 5, 7, 8, 10, 12

LastDayOfMonth = 31

Case 4, 6, 9, 11

LastDayOfMonth = 30

Case 2

LastDayOfMonth = 28

End Select

End Function

---

Public Function WeekDayName(ByVal WeekDayNum As Integer) As String

Select Case WeekDayNum

Case 1

WeekDayName = “Sunday”

Case 2

WeekDayName = “Monday”

Case 3

WeekDayName = “Tuesday”

Case 4

WeekDayName = “Wednesday”

Case 5

WeekDayName = “Thursday”

Case 6

WeekDayName = “Friday”

Case 7

WeekDayName = “Saturday”

Case Else

MsgBox “This function returns the name of the weekday that was passed in.” & _

“Valid parameter values are 1-7 corresponding to weekdays Sunday through Saturday.”

End Select

End Function

---

Download the code.

There is a setting on a Windows PC to “Automatically adjust clock for daylight saving changes.” If you change this setting your appointments and meetings in your Microsoft Outlook calendar may be moved. Outlook does this intentionally and is not a bug.

Below is a code sample of how to fix your appointments. 

Attribute VB_Name = “DayLightSavingsFix”Public Sub DayLightSavingsFix()‘***************************************************************************‘This macro will go through all items in a Calendar and change the start time to one hour back.‘It will ignore anything that is not an Appointment or a Meeting‘It will also ignore any all day events.‘This macro will change only items that were created before 1/1/08‘***************************************************************************

Dim CurFolder, MyItems

Dim NumItems As Integer, i As Integer

Dim MyItem As Object

‘Use whichever folder is currently selected

‘This means that you should run this macro with your Calendar folder selected.

Set CurFolder = Application.ActiveExplorer.CurrentFolder

‘Make sure the current folder is a Calendar folder

If CurFolder.DefaultItemType = 1 Then

‘get a handle on the items in the Calendar folder

Set MyItems = CurFolder.Items

NumItems = MyItems.Count

‘loop through all of the Calendar items

For i = 1 To NumItems

On Error Resume Next ‘ignore any errors

Set MyItem = MyItems.Item(i)

If TypeName(MyItem) = “AppointmentItem” Then

‘check to see if item was created before Jan 01 and not an all day event

If DateDiff(”d”, MyItem.CreationTime, “1/1/08 2:00:00 AM”) >= 1 And MyItem.AllDayEvent = False Then

‘change the start time back one hour, end time is automatically adjusted

MyItem.Start = DateAdd(”h”, -1, MyItem.Start)

MyItem.Save

End If

ElseIf TypeName(MyItem) = “MeetingItem” Then

‘check to see if item was created before Jan 1 and not an all day event

If DateDiff(”d”, MyItem.CreationTime, “1/1/08 2:00:00 AM”) >= 1 And MyItem.GetAssociatedAppointment.AllDayEvent = False Then

‘change the start time back one hour, end time is automatically adjusted

MyItem.GetAssociatedAppointment.Start = DateAdd(”h”, -1, MyItem.GetAssociatedAppointment.Start)

MyItem.Save

End If

End If

Next i

MsgBox “Done”

Else

MsgBox “The current folder needs to be a Calendar folder before running this macro.”

End If

‘ Cleanup

Set MyItem = Nothing

Set MyItems = Nothing

Set CurFolder = Nothing

End Sub

To run this code, open Microsoft Outlook and click Tools, Marco, Visual Basic Editor.  Your screen may look something like the following.

 

Paste the code into the right side.  Adjust the date for your own needs. 

Note: This code has been tested and confirmed with Microsoft Outlook versions 2000, 2002 and 2003.   The complete code can also be downloaded here.