Rnd Random Function

Rnd Random function is a short code snippet that shows how the useful Rnd Random function VBA macro is working.

Explanation

The program randomly changes the colorindex in the cells in the excel sheet, the cell is also chosen randomly by selecting a random column and a random row within a predefined range. The random function is actually never totally random as today the human cannot create a random function that is 100% random it is always based on some kind of samples of data and based on the sample numbers are executed. This approach will create loops and making data reappear systematically.

Code

Sub Random_FunctionRND()

For lups = 1 To 10000
    Randomize
    Color2 = Int((50 * Rnd) + 1)
    Row = Int((25 * Rnd) + 1)
    Column = Int((25 * Rnd) + 1)
    Range("G2").Offset(Row - 1, Column - 1).Interior.ColorIndex = Color2
Next

End Sub

Read Text File Fetch Data

This code snippet reads a text file and fetches the data into the worksheet.

Explanation

This short program extracts the text stored in a predefined text file in predefined folder or directory. The program can be modify to loop through many text files by using the "List files in directory" code, this requires modification by yourself. When making programs that store data in text files not real databases this comes in handy. If you do not perform many database calls per seconds it is ok to use text files as database.

Code

Public Sub ReadTextFileFetchData()

Dim NameOfFile As String
Dim PlaceOfFile As String
Dim Filelocation As String

NameOfFile = Range("c6").Value
PlaceOfFile = Range("c5").Value
Filelocation = PlaceOfFile + "\" + NameOfFile
sText = ReadTextFileFetchDataMain(Filelocation)
Range("c10").Value = sText

End Sub


Function ReadTextFileFetchDataMain(ReadTextFile As String) As String
Dim ReadTextFileSource As Integer
Dim ReadTextFile2 As String

'Closes text files that might be opened
Close
'The number of the next free text file
ReadTextFileSource = FreeFile
Open ReadTextFile For Input As #ReadTextFileSource
ReadTextFile2 = Input$(LOF(1), 1)
Close
ReadTextFileFetchDataMain = ReadTextFile2
End Function

Open Close Save As Word File

This program opens a word file on a predefined location and saves the file with another name to another place.

Explanation

In order to make the program work the reference “Microsoft Word XX.X Object Library” needs to be enabled.
The program opens a word file on a predefined place and saves the file with another name to another place. This can be useful when making quotations or other processes that need customization with text from different databases. The communication between word and excel is fully supported.

Code

Sub Open_Close_Save_As_Word_File()

Dim Open_Close_Save_As_Word_File_APP As Word.Application
Dim Open_Close_Save_As_Word_File_DOC As Word.Document
Set Open_Close_Save_As_Word_File_APP = CreateObject("Word.Application")

Dim PlaceOfWordFile As String
Dim NameOfWordFile As String
Dim NewPlaceOfWordFile As String
Dim NewNameOfWordFile As String

PlaceOfWordFile = Range("B4").Value
NameOfWordFile = Range("B5").Value
NewPlaceOfWordFile = Range("B6").Value
NewNameOfWordFile = Range("B7").Value

NamePlace = PlaceOfWordFile + "\" + NameOfWordFile
NewNamePlace = NewPlaceOfWordFile + "\" + NewNameOfWordFile

Open_Close_Save_As_Word_File_APP.Visible = True
Set Open_Close_Save_As_Word_File_DOC = Open_Close_Save_As_Word_File_APP.Documents.Open(NamePlace, ReadOnly:=True)

Open_Close_Save_As_Word_File_DOC.SaveAs (NewNamePlace)
Open_Close_Save_As_Word_File_APP.Quit

Set Open_Close_Save_As_Word_File_DOC = Nothing
Set Open_Close_Save_As_Word_File_APP = Nothing

End Sub

Manual, Semi Automatic and Automatic Calculation or Call Calculation in VBA

A program for setting the calculation options or calling the calculation on demand.

Explanation

To be able to calculate only on demand can be time saving in some situation when writing figures to the excel sheet if it contains a lot of formulas then it can be good to set the calculation option to manual. On the other hand if combining code with formulas the formulas needs to be updated before data is extracted from the sheet, then it is good to be able to call the calculate on demand. Normally if you only have a small number of formulas then this function is not relevant but for large scale formulas then is very good if you want to speed optimize your program.

Code

Public Sub Manual_Semi_Automatic_and_Automatic_Calculation_or_Call_Calculation_in_VBA ()

If range(“C5”).value=1 then
Application.Calculation = xlAutomatic
End if

If range(“C5”).value=1 then
Application.Calculation = xlSemiautomatic
End if

If range(“C5”).value=1 then
Application.Calculation = xlManual

End sub

Public Sub Calculate_On_Demand_VBA ()

Calculate

End sub

Make Excel Invisible and Hide Excel

The code makes excel invisible for 10 seconds and then excel will get visible again.

Explanation

The code makes excel invisible for 10 seconds, this might be useful in some situations, and then excel will get visible again. The entire program will be invisible thus make sure to make excel visible again because otherwise you will not be able to change this setting back without terminating the program in other ways.

Code

Public Sub HideExcelMakeExcelInvisible()

’Makes the excel invisible.
Application.Visible = False

’In order to be able to get back to excel there is a waiting time for 10 seconds then the application will be visible again.
Application.Wait Now + TimeValue("00:00:10")

’Makes the excel visible again.
Application.Visible = True

End Sub

List Files In Directory

A simple program for listing all files in a certain directory by calling a VBA Macro Code.

Explanation

The program is set up by giving input about which folder/directory that the program shall analyse. The VBA program then uses the Dir function to get the information about what files are stored in the folder/directory. Then the program simply writes the data to the worksheet. It is possible to use the data in an array if wanting to modify and use the code in an other program. This is a good function when you need to write something or perform an operation to all files stored in a certain folder but you do not know exactly what the files are called or how many they are.

Code

Public Sub List_Files_In_Directory()

Range("A5:A2000").ClearContents

Dim List_Files_In_Directory(10000, 1)
Dim One_File_List   As String
Dim Number_Of_Files_In_Directory As Long

One_File_List = Dir$("C:" + "\*.*")
Do While One_File_List <> ""
    List_Files_In_Directory(Number_Of_Files_In_Directory, 0) = One_File_List
    One_File_List = Dir$
    Number_Of_Files_In_Directory = Number_Of_Files_In_Directory + 1
Loop

Number_Of_Files_In_Directory = 0
While List_Files_In_Directory(Number_Of_Files_In_Directory, 0) <> tom
    Range("A5").Offset(Number_Of_Files_In_Directory, 0).Value = List_Files_In_Directory(Number_Of_Files_In_Directory, 0)
    Number_Of_Files_In_Directory = Number_Of_Files_In_Directory + 1
Wend

End Sub

Insert Image to Word, Resize Image, Insert Borders using VBA Excel

The program inserts an image to a word file and resizes the images and inserts a border.

Explanation

This VBA program is developed to extract an image and insert it to word file resize the image according the settings in the worksheet and surround the image with a border. The image can be re-sized using this code but the image will not change in terms of size in kilobytes. To compress an image using VBA is not possible this has to be done manually.

In order to make the program work the reference “Microsoft Word XX.X Object Library” needs to be enabled.Example file of the VBA code is available for downloading at the bottom of this web page, enjoy! Or just copy and paste the code directly from this page.

Code

Public Sub Insert_Image_to_Word_Resize_Image_Insert_Borders_using_VBA_Excel()

Dim Insert_Image_to_Word_Resize_Image_Insert_Borders_using_VBA_Excel_APP As Word.Application
Dim Insert_Image_to_Word_Resize_Image_Insert_Borders_using_VBA_Excel_DOC As Word.Document
Set Insert_Image_to_Word_Resize_Image_Insert_Borders_using_VBA_Excel_APP = CreateObject("Word.Application")

Dim PlaceOfWordFile As String
Dim NameOfWordFile As String

PlaceOfWordFile = Range("B4").Value
NameOfWordFile = Range("B5").Value

PlaceOfImageFile = Range("B6").Value
NameOfImageFile = Range("B7").Value

NamePlaceImage = PlaceOfImageFile + "\" + NameOfImageFile
NamePlace = PlaceOfWordFile + "\" + NameOfWordFile

Insert_Image_to_Word_Resize_Image_Insert_Borders_using_VBA_Excel_APP.Visible = True

Set Insert_Image_to_Word_Resize_Image_Insert_Borders_using_VBA_Excel_DOC = Insert_Image_to_Word_Resize_Image_Insert_Borders_using_VBA_Excel_APP.Documents.Open(NamePlace, ReadOnly:=False)

Set WORD_Image = Insert_Image_to_Word_Resize_Image_Insert_Borders_using_VBA_Excel_APP.Selection.InlineShapes.AddPicture(NamePlaceImage, False, True)
   
HeightOfImage = Range("D5").Value
   
With WORD_Image
    H = .Height
    B = .Width
    Ratio = H / B
    .Height = HeightOfImage
    .Width = HeightOfImage / Ratio
End With

WORD_Image.Borders.OutsideLineStyle = wdLineStyleSingle

Insert_Image_to_Word_Resize_Image_Insert_Borders_using_VBA_Excel_DOC.Save
Insert_Image_to_Word_Resize_Image_Insert_Borders_using_VBA_Excel_APP.Quit

Set Insert_Image_to_Word_Resize_Image_Insert_Borders_using_VBA_Excel_DOC = Nothing
Set Insert_Image_to_Word_Resize_Image_Insert_Borders_using_VBA_Excel_APP = Nothing

End Sub