Write Text to Word From Excel using VBA

This program opens a word file and writes text into it and customizes the text slightly.

Explanation

The VBA program opens an already existing word file stored on a hard drive and writes text into the file and makes the text bold etc. Afterwards the file is saved and closed and stored at the same location. This function can be used when making own programs for making customized quotations for example when the existing business system is not sufficient. Almost all customization that can be done with the word file is possible to perform using VBA or the template can be customized before writing text to the file.

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

Code

Public Sub Write_Text_to_Word_From_Excel_using_VBA()

Dim Write_Text_to_Word_From_Excel_using_VBA_APP As Word.Application
Dim Write_Text_to_Word_From_Excel_using_VBA_DOC As Word.Document
Set Write_Text_to_Word_From_Excel_using_VBA_APP = CreateObject("Word.Application")

Dim PlaceOfWordFile As String
Dim NameOfWordFile As String

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

NamePlace = PlaceOfWordFile + "\" + NameOfWordFile

Write_Text_to_Word_From_Excel_using_VBA_APP.Visible = True

Set Write_Text_to_Word_From_Excel_using_VBA_DOC = Write_Text_to_Word_From_Excel_using_VBA_APP.Documents.Open(NamePlace, ReadOnly:=False)

Row = 0
While Range("B8").Offset(Row, 0).Value <> tom
    Write_Text_to_Word_From_Excel_using_VBA_APP.Selection.Font.Name = Range("B8").Offset(Row, 2).Value
    Write_Text_to_Word_From_Excel_using_VBA_APP.Selection.Font.Size = Range("B8").Offset(Row, 1).Value
    Write_Text_to_Word_From_Excel_using_VBA_APP.Selection.TypeText Text:=Range("B8").Offset(Row, 0).Value
    Write_Text_to_Word_From_Excel_using_VBA_APP.Selection.TypeParagraph
    Row = Row + 1
Wend

Write_Text_to_Word_From_Excel_using_VBA_DOC.Save
Write_Text_to_Word_From_Excel_using_VBA_APP.Quit

Set Write_Text_to_Word_From_Excel_using_VBA_DOC = Nothing
Set Write_Text_to_Word_From_Excel_using_VBA_APP = Nothing
End Sub

VBA Message Box Yes or No MsgBox

Code for calling a message box with the option Yes or No and depending on the answer different coding is executed.

Explanation

To call a message box with the option Yes or No and depending on the answer different execute different sub programs is good when trying a more interactive approach with the end-user. By using this function you can choose path of the rest of the program if the user answers yes then a certain code is run and if the user answers no another code is run. Simple and clever!

Code

Public Sub MessageBoxYesOrNoMsgBox()

Dim YesOrNoAnswerToMessageBox As String
Dim QuestionToMessageBox As String

    QuestionToMessageBox = "Are you an expert of VBA?"

    YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "VBA Expert or Not")

    If YesOrNoAnswerToMessageBox = vbNo Then
         MsgBox "Learn more VBA!"
    Else
        MsgBox "Congratulations!"
    End If

End Sub

VBA Error Handling On Error Resume Next

This macro code enables the On Error Resume Next function.

Explanation

To enable On Error Resume Next will make the VBA program skip code that generates an error and normally stops the program.A basic example file of the VBA macro is available for download at the bottom of this web page, or just copy and paste the code directly from this page.
In many cases it is done clever to enable the on error resume next function because the bugs in your code will not be easily found. However in some cases when you know that there might appear an error that you want the program to ignore you can disable or enable the function. After the program has run the code lines that is relevant for the problem make sure to enable the function again.

Code

Public Sub Error_Handling_VBA_On_Error_Resume_Next()

'The error function is turned off in case of error just continue
On Error Resume Next

'An error statment is trying to be executed and no error occurs due to On Error Resume Next
Test = 5 / 0

'Normal error handling is turned on again
On Error GoTo 0

End Sub

Update MySQL database PHP

Updating existing data in a MySQL database is easily done by using this VBA Macro code. Many are using the methodology when working with websites developed in PHP and MySQL.

Explanation

This VBA Macro code is optimized for updating an exsisting MySQL database. You need a connector, ODBC for latest version mysql.com download the excel file ate the bottom of this page or copy and paste the code directly. In the file there are some data that needs to be added according to your set up of the MySQL database and connection. Fill in the data and add the required fileds that you are going to update. Push the buttom and you will be updating existing data in your MySQL database. MySQL is one of the most effective databases and the best thing is that it is used free of charge.

Code

Sub UpdateMySQLDatabasePHP()

' For detailed description visit http://www.vbaexcel.eu/

Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
User_ID = Range("h1").Value                      'i d user or username
Password = Range("e3").Value                    ' Password
Server_Name = Range("e4").Value             ' IP number or servername
Database_Name = Range("e1").Value         ' Name of database
Tabellen = Range("e2").Value                     ' Name of table to write to

rad = 0
While Range("a6").Offset(rad, 0).Value <> tom
    TextStrang = tom
    kolumn = 0
    While Range("A5").Offset(0, kolumn).Value <> tom
        If kolumn = 0 Then TextStrang = TextStrang & Cells(5, 1) & " = '" & Cells(6 + rad, 1)
        If kolumn <> 0 Then TextStrang = TextStrang & "', " & Cells(5, 1 + kolumn) & " = '" & Cells(6 + rad, 1 + kolumn)
        kolumn = kolumn + 1
    Wend
    TextStrang = TextStrang & "'"
    SQLStr = "UPDATE " & Tabellen & " SET " & TextStrang & "WHERE " & Cells(5, 1) & " = '" & Cells(6 + rad, 1) & "'"
    Set Cn = New ADODB.Connection
    Cn.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & Server_Name & ";Database=" & Database_Name & _
    ";Uid=" & User_ID & ";Pwd=" & Password & ";"
    Cn.Execute SQLStr
    rad = rad + 1
Wend
Set rs = Nothing
Cn.Close
Set Cn = Nothing

End Sub

Sudoku Solver

A professional tool to be able to solve complex sudoku games. The VBA program uses logic and guess functions to solve the game.

Explanation

Sudoku solver uses basic logic functions and by this approach eliminates possible numbers in certain positions. For complex games it also has a guess function and loops through different solutions until the correct one is found. This sudoku solver will solve all sudokus also the impossible ones or the ones where only one figure is to start with. When starting with a very low number of data the outcome can vary and the program will find different end solutions. In some cases the program tries an approach that fails then the program starts again and finally the right solution is found. The program can be optimized in speed if the visual effects is turned off before executing the program.

Code

Public Sub Sudoku_Solver_One()
'Start program to solve one step
Total = False
Call Sudoku_Solver(Total)
End Sub
Public Sub Sudoku_Solver_Total()
'Start program to solve complete
Total = True
Call Sudoku_Solver(Total)
End Sub

Public Sub Sudoku_Solver(Total)

Range("N3:V11").ClearContents
Range("N3:V11").Interior.ColorIndex = 0

'write_it controls if the program has written anything new to the matrix if not then the guess program is executed
write_it = False

'The array containing all data
Dim Sudoku_Solver(9, 9, 40)

Call ReadInData(Sudoku_Solver)
Call write_itData(Sudoku_Solver, write_it)
Call DetermineReady(Sudoku_Solver)

lups = 0
ER = False
While ER = False
    For Row = 1 To 9
        For Column = 1 To 9
            If Sudoku_Solver(Row, Column, 0) = tom Then
                write_it = False
                'Basic methods for solving Sudoku
                Call QuadrantCheck(Sudoku_Solver, Row, Column, write_it)
                Call RowCheck(Sudoku_Solver, Row, Column, write_it)
                Call ColumnCheck(Sudoku_Solver, Row, Column, write_it)
                Call QuadrantCheckIN(Sudoku_Solver, Row, Column, write_it)
                Call RowCheckIN(Sudoku_Solver, Row, Column, write_it)
                Call ColumnCheckIN(Sudoku_Solver, Row, Column, write_it)
                Call DetermineReady(Sudoku_Solver)
            End If
        Next
    Next

'?!?!

    ReStart = False
    'Searches for errors if the error is found during first run the program ends
    Call CheckError(Sudoku_Solver, ReStart, start)
    If ReStart = True Then
        write_it = True
        Erase Sudoku_Solver
        Call ReadInData(Sudoku_Solver)
        Range("N3:V11").ClearContents
        Call write_itData(Sudoku_Solver, write_it)
        StartAllOver = StartAllOver + 1
        If StartAllOver > 1000 Then
            End
        End If
        If lups = 0 Then
            End
        End If
  
    End If

    If write_it = False Then
        Call Guess(Sudoku_Solver, write_it, StartAllOver)
    End If

    Call DetermineReady(Sudoku_Solver)
    If Total = True Then
        Call write_itData(Sudoku_Solver, write_it)
    End If
    Call CheckReady(Sudoku_Solver, ER)
    lups = lups + 1
Wend

If Total = False Then
    Call WriteOne(Sudoku_Solver)
End If

End Sub

Public Sub ReadInData(Sudoku_Solver)

For Row = 1 To 9
    For Column = 1 To 9
        Sudoku_Solver(Row, Column, 11) = Range("c3").Offset(Row - 1, Column - 1).Value
        Sudoku_Solver(Row, Column, 0) = Range("c3").Offset(Row - 1, Column - 1).Value
        If Sudoku_Solver(Row, Column, 0) = tom Then
            For loops = 1 To 9
                Sudoku_Solver(Row, Column, loops) = 1
            Next
        Else
            For loops = 1 To 9
                Sudoku_Solver(Row, Column, loops) = 0
            Next
        End If

        If Column < 4 Then
            If Row < 4 Then
                Sudoku_Solver(Row, Column, 10) = 1
            End If
            If Row < 7 And Row > 3 Then
                Sudoku_Solver(Row, Column, 10) = 4
            End If
            If Row > 6 Then
                Sudoku_Solver(Row, Column, 10) = 7
            End If
        End If

        If Column < 7 And Column > 3 Then
            If Row < 4 Then
                Sudoku_Solver(Row, Column, 10) = 2
            End If
            If Row < 7 And Row > 3 Then
                Sudoku_Solver(Row, Column, 10) = 5
            End If
            If Row > 6 Then
                Sudoku_Solver(Row, Column, 10) = 8
            End If
        End If

        If Column > 6 Then
            If Row < 4 Then
                Sudoku_Solver(Row, Column, 10) = 3
            End If
            If Row < 7 And Row > 3 Then
                Sudoku_Solver(Row, Column, 10) = 6
            End If
            If Row > 6 Then
                Sudoku_Solver(Row, Column, 10) = 9
            End If
        End If
    Next
Next

End Sub



Public Sub write_itData(Sudoku_Solver, write_it)

For Row = 1 To 9
    For Column = 1 To 9
        If Range("n3").Offset(Row - 1, Column - 1).Value = tom Then
            If Sudoku_Solver(Row, Column, 0) <> tom Then
                Range("n3").Offset(Row - 1, Column - 1).Value = Sudoku_Solver(Row, Column, 0)
                write_it = True
            End If
        End If
    Next
Next

End Sub

Public Sub DetermineReady(Sudoku_Solver)

For Row = 1 To 9
    For Column = 1 To 9
        For värde = 1 To 9
            If Sudoku_Solver(Row, Column, värde) = 1 Then
                antal = antal + 1
                värdeTal = värde
            End If
        Next
        If antal = 1 Then
            Sudoku_Solver(Row, Column, värdeTal) = 0
            Sudoku_Solver(Row, Column, 0) = värdeTal
        End If
        antal = 0
    Next
Next

End Sub

'?!?!

Public Sub QuadrantCheck(Sudoku_Solver, Row, Column, write_it)

kvadrant = Sudoku_Solver(Row, Column, 10)

For RowT = 1 To 9
    For ColumnT = 1 To 9
        If Sudoku_Solver(RowT, ColumnT, 10) = kvadrant Then
            If Sudoku_Solver(RowT, ColumnT, 0) <> tom Then
                tal = Sudoku_Solver(RowT, ColumnT, 0)
            If Sudoku_Solver(Row, Column, tal) = 1 Then
                Sudoku_Solver(Row, Column, tal) = 0
                write_it = True
            End If
            End If
        End If
    Next
Next

End Sub


Public Sub RowCheck(Sudoku_Solver, Row, Column, write_it)

For ColumnT = 1 To 9
    If Sudoku_Solver(Row, ColumnT, 0) <> tom Then
        värdeTal = Sudoku_Solver(Row, ColumnT, 0)
        If Sudoku_Solver(Row, Column, värdeTal) = 1 Then
            Sudoku_Solver(Row, Column, värdeTal) = 0
            write_it = True
        End If
    End If
Next

End Sub

Public Sub ColumnCheck(Sudoku_Solver, Row, Column, write_it)

For RowT = 1 To 9
    If Sudoku_Solver(RowT, Column, 0) <> tom Then
        värdeTal = Sudoku_Solver(RowT, Column, 0)
        If Sudoku_Solver(Row, Column, värdeTal) = 1 Then
            Sudoku_Solver(Row, Column, värdeTal) = 0
            write_it = True
        End If
    End If
Next

End Sub



Public Sub QuadrantCheckIN(Sudoku_Solver, Row, Column, write_it)

kvadrant = Sudoku_Solver(Row, Column, 10)

For värde = 1 To 9
    unik = True
    If Sudoku_Solver(Row, Column, värde) = 1 Then
        For RowT = 1 To 9
            For ColumnT = 1 To 9
                If Sudoku_Solver(RowT, ColumnT, 10) = kvadrant Then
                    If Sudoku_Solver(RowT, ColumnT, 0) = värde Then unik = False
                    If Sudoku_Solver(RowT, ColumnT, värde) = 1 Then
                        If Row = RowT And Column = ColumnT Then
                        Else
                            unik = False
                        End If
                    End If
                End If
            Next
        Next

        If unik = True Then
            Sudoku_Solver(Row, Column, 0) = värde
            write_it = True
            For lups = 1 To 9
                Sudoku_Solver(Row, Column, lups) = 0
            Next
        End If
  End If
Next

End Sub

Public Sub RowCheckIN(Sudoku_Solver, Row, Column, write_it)

For värde = 1 To 9
    unik = True
    If Sudoku_Solver(Row, Column, värde) = 1 Then
        For ColumnT = 1 To 9
            If Sudoku_Solver(Row, ColumnT, 0) = värde Then
                unik = False
            End If
            If Sudoku_Solver(Row, ColumnT, värde) = 1 Then
                If ColumnT <> Column Then
                    unik = False
                End If
            End If
        Next
        If unik = True Then
            Sudoku_Solver(Row, Column, 0) = värde
            write_it = True
            For lups = 1 To 9
                Sudoku_Solver(Row, Column, lups) = 0
            Next
        End If
    End If
Next

End Sub

'?!?!

Public Sub ColumnCheckIN(Sudoku_Solver, Row, Column, write_it)

kvadrant = Sudoku_Solver(Row, Column, 10)

For värde = 1 To 9
    unik = True
    If Sudoku_Solver(Row, Column, värde) = 1 Then
        For RowT = 1 To 9
            If Sudoku_Solver(RowT, Column, 0) = värde Then
                unik = False
            End If
            If Sudoku_Solver(RowT, Column, värde) = 1 Then
                If RowT <> Row Then
                    unik = False
                End If
            End If
        Next
        If unik = True Then
            Sudoku_Solver(Row, Column, 0) = värde
            write_it = True
            For lups = 1 To 9
                Sudoku_Solver(Row, Column, lups) = 0
            Next
        End If
    End If
Next

End Sub

Public Sub Guess(Sudoku_Solver, write_it, StartAllOver)

'identify best guess place

SlutSumma = 10
For Row = 1 To 9
    For Column = 1 To 9
        If Sudoku_Solver(Row, Column, 0) = tom Then
            For lups = 1 To 9
                summa = summa + Sudoku_Solver(Row, Column, lups)
            Next
            If summa < SlutSumma Then
                SlutRow = Row
                SlutColumn = Column
                SlutSumma = summa
            End If
            summa = 0
        End If
    Next
Next

If SlutSumma <> 0 Then
    'Random number between 1 and 9
    hittat = False
    While hittat = False
        Randomize
        tal = Int((9 * Rnd) + 1)
        If Sudoku_Solver(SlutRow, SlutColumn, tal) = 1 Then
            hittat = True
            Sudoku_Solver(SlutRow, SlutColumn, 0) = tal
            For lups = 1 To 9
                Sudoku_Solver(SlutRow, SlutColumn, lups) = 0
                write_it = True
            Next
        End If
    Wend
Else
    Erase Sudoku_Solver
    write_it = True
    Range("N3:V11").ClearContents
    Call ReadInData(Sudoku_Solver)
    Call write_itData(Sudoku_Solver, write_it)
    StartAllOver = StartAllOver + 1
    If StartAllOver > 1000 Then
        End
    End If
End If

'?!?!

End Sub

Public Sub CheckError(Sudoku_Solver, ReStart, start)

Dim R(9)
Dim C(9)

For Value = 1 To 9
    For Row = 1 To 9
        Erase R
        For Column = 1 To 9
            If Sudoku_Solver(Row, Column, 0) <> 0 Then
                R(Sudoku_Solver(Row, Column, 0)) = R(Sudoku_Solver(Row, Column, 0)) + 1
                If R(Sudoku_Solver(Row, Column, 0)) > 1 Then ReStart = True
            End If
        Next
    Next
    For Column2 = 1 To 9
        Erase C
        For Row2 = 1 To 9
            If Sudoku_Solver(Row2, Column2, 0) <> 0 Then
                C(Sudoku_Solver(Row2, Column2, 0)) = C(Sudoku_Solver(Row2, Column2, 0)) + 1
                If C(Sudoku_Solver(Row2, Column2, 0)) > 1 Then ReStart = True
            End If
        Next
    Next
Next

End Sub



Public Sub CheckReady(Sudoku_Solver, ER)

For Row = 1 To 9
    For Column = 1 To 9
        Summan = Summan + Sudoku_Solver(Row, Column, 0)
        If Sudoku_Solver(Row, Column, 0) <> tom Then
            Summan2 = Summan2 + 1
        End If
    Next
Next

If Summan = 405 And Summan2 = 81 Then
    ER = True
End If

End Sub

Public Sub WriteOne(Sudoku_Solver)

OneRandom = False
While OneRandom = False
    Randomize
    Row = Int((9 * Rnd) + 1)
    Column = Int((9 * Rnd) + 1)
    If Sudoku_Solver(Row, Column, 11) = tom Then
        Range("n3").Offset(Row - 1, Column - 1).Value = Sudoku_Solver(Row, Column, 0)
        Range("n3").Offset(Row - 1, Column - 1).Interior.ColorIndex = 4
    OneRandom = True
    End If
Wend

End Sub

Sudoku Games Generator

Soduko Games Generator is a program that generates Sudoku games with chosen difficulty and complexity levels.

Explanation

The program is basically developed and programmed based on the Sudoku Solver (also available here on this site) and the approach is to try to solve a Sudoku without any start values, an empty matrix that is. The program then uses the logic functions and guess functions in order to find a solution for the Sudoku game. You can make sudokus with different difficult levels. Starting with less data makes the sudoku harder to solve but if you enter to few data the result can be that different end solutions can be found all are correct though. Make sure to test the program in the solver and make sure that only one solution can be found before giving the game to friends.

Code

Public Sub Sudoku_Games_Generator()

Range("N3:V11").ClearContents
Range("C3:K11").ClearContents
Range("C14:K22").ClearContents
Range("N14:V22").ClearContents
Range("C25:K33").ClearContents
Range("N25:V33").ClearContents

'The array containing all data
Dim Sudoku_Games_Generator(9, 9, 40)

For lupar2 = 1 To 6
Erase Sudoku_Games_Generator
'Check_Var controls if the program has written anything new to the matrix if not then the guess program is executed
Check_Var = False



Call ReadInData(Sudoku_Games_Generator)

Call ReadyOrNot(Sudoku_Games_Generator)
StartAllOver = 0
lups = 0
ER = False
While ER = False
    For Row = 1 To 9
        For Column = 1 To 9
            If Sudoku_Games_Generator(Row, Column, 0) = tom Then
                Check_Var = False
                'Basic methods for solving Sudoku
                Call CheckQ2(Sudoku_Games_Generator, Row, Column, Check_Var)
                Call CheckR2(Sudoku_Games_Generator, Row, Column, Check_Var)
                Call CheckC2(Sudoku_Games_Generator, Row, Column, Check_Var)
                Call CheckQ2IN(Sudoku_Games_Generator, Row, Column, Check_Var)
                Call CheckR2IN(Sudoku_Games_Generator, Row, Column, Check_Var)
                Call CheckC2IN(Sudoku_Games_Generator, Row, Column, Check_Var)
                Call ReadyOrNot(Sudoku_Games_Generator)
            End If
        Next
    Next
'?!?!

    ReStart = False
    'Searches for errors if the error is found during first run the program ends
    Call CheckError(Sudoku_Games_Generator, ReStart, start)
    If ReStart = True Then
        Check_Var = True
        Erase Sudoku_Games_Generator
        Call ReadInData(Sudoku_Games_Generator)
        StartAllOver = StartAllOver + 1
        If StartAllOver > 1000 Then
            End
        End If
        If lups = 0 Then
            End
        End If
   
    End If

    If Check_Var = False Then
        Call Guess(Sudoku_Games_Generator, Check_Var, StartAllOver)
    End If

    Call ReadyOrNot(Sudoku_Games_Generator)
    Call CheckReady(Sudoku_Games_Generator, ER)
    lups = lups + 1
Wend

Call EraseData(Sudoku_Games_Generator, Range("N1").Value)
Call Check_VarData(Sudoku_Games_Generator, Check_Var, lupar2)
Next

End Sub

Public Sub ReadInData(Sudoku_Games_Generator)

For Row = 1 To 9
    For Column = 1 To 9
        Sudoku_Games_Generator(Row, Column, 11) = tom
        Sudoku_Games_Generator(Row, Column, 0) = tom
        If Sudoku_Games_Generator(Row, Column, 0) = tom Then
            For loops = 1 To 9
                Sudoku_Games_Generator(Row, Column, loops) = 1
            Next
        Else
            For loops = 1 To 9
                Sudoku_Games_Generator(Row, Column, loops) = 0
            Next
        End If

        If Column < 4 Then
            If Row < 4 Then
                Sudoku_Games_Generator(Row, Column, 10) = 1
            End If
            If Row < 7 And Row > 3 Then
                Sudoku_Games_Generator(Row, Column, 10) = 4
            End If
            If Row > 6 Then
                Sudoku_Games_Generator(Row, Column, 10) = 7
            End If
        End If

        If Column < 7 And Column > 3 Then
            If Row < 4 Then
                Sudoku_Games_Generator(Row, Column, 10) = 2
            End If
            If Row < 7 And Row > 3 Then
                Sudoku_Games_Generator(Row, Column, 10) = 5
            End If
            If Row > 6 Then
                Sudoku_Games_Generator(Row, Column, 10) = 8
            End If
        End If

        If Column > 6 Then
            If Row < 4 Then
                Sudoku_Games_Generator(Row, Column, 10) = 3
            End If
            If Row < 7 And Row > 3 Then
                Sudoku_Games_Generator(Row, Column, 10) = 6
            End If
            If Row > 6 Then
                Sudoku_Games_Generator(Row, Column, 10) = 9
            End If
        End If
    Next
Next

End Sub


Public Sub Check_VarData(Sudoku_Games_Generator, Check_Var, lupar2)

If lupar2 = 1 Then
    RowPos = 0
    ColumnPos = 0
End If

If lupar2 = 2 Then
    RowPos = 0
    ColumnPos = 11
End If

If lupar2 = 3 Then
    RowPos = 11
    ColumnPos = 0
End If

If lupar2 = 4 Then
    RowPos = 11
    ColumnPos = 11
End If

'?!?!

If lupar2 = 5 Then
    RowPos = 22
    ColumnPos = 0
End If

If lupar2 = 6 Then
    RowPos = 22
    ColumnPos = 11
End If

For Row = 1 To 9
    For Column = 1 To 9
        If Range("c3").Offset(RowPos - 1 + Row, ColumnPos - 1 + Column).Value = tom Then
            If Sudoku_Games_Generator(Row, Column, 0) <> tom Then
                Range("c3").Offset(RowPos - 1 + Row, ColumnPos - 1 + Column).Value = Sudoku_Games_Generator(Row, Column, 0)
                Check_Var = True
            End If
        End If
    Next
Next

End Sub

Public Sub ReadyOrNot(Sudoku_Games_Generator)

For Row = 1 To 9
    For Column = 1 To 9
        For värde = 1 To 9
            If Sudoku_Games_Generator(Row, Column, värde) = 1 Then
                antal = antal + 1
                värdeTal = värde
            End If
        Next
        If antal = 1 Then
            Sudoku_Games_Generator(Row, Column, värdeTal) = 0
            Sudoku_Games_Generator(Row, Column, 0) = värdeTal
        End If
        antal = 0
    Next
Next

End Sub


Public Sub CheckQ2(Sudoku_Games_Generator, Row, Column, Check_Var)

kvadrant = Sudoku_Games_Generator(Row, Column, 10)

For RowT = 1 To 9
    For ColumnT = 1 To 9
        If Sudoku_Games_Generator(RowT, ColumnT, 10) = kvadrant Then
            If Sudoku_Games_Generator(RowT, ColumnT, 0) <> tom Then
                tal = Sudoku_Games_Generator(RowT, ColumnT, 0)
            If Sudoku_Games_Generator(Row, Column, tal) = 1 Then
                Sudoku_Games_Generator(Row, Column, tal) = 0
                Check_Var = True
            End If
            End If
        End If
    Next
Next

End Sub


Public Sub CheckR2(Sudoku_Games_Generator, Row, Column, Check_Var)

For ColumnT = 1 To 9
    If Sudoku_Games_Generator(Row, ColumnT, 0) <> tom Then
        värdeTal = Sudoku_Games_Generator(Row, ColumnT, 0)
        If Sudoku_Games_Generator(Row, Column, värdeTal) = 1 Then
            Sudoku_Games_Generator(Row, Column, värdeTal) = 0
            Check_Var = True
        End If
    End If
Next

End Sub

Public Sub CheckC2(Sudoku_Games_Generator, Row, Column, Check_Var)

For RowT = 1 To 9
    If Sudoku_Games_Generator(RowT, Column, 0) <> tom Then
        värdeTal = Sudoku_Games_Generator(RowT, Column, 0)
        If Sudoku_Games_Generator(Row, Column, värdeTal) = 1 Then
            Sudoku_Games_Generator(Row, Column, värdeTal) = 0
            Check_Var = True
        End If
    End If
Next

End Sub



Public Sub CheckQ2IN(Sudoku_Games_Generator, Row, Column, Check_Var)

kvadrant = Sudoku_Games_Generator(Row, Column, 10)

For värde = 1 To 9
    unik = True
    If Sudoku_Games_Generator(Row, Column, värde) = 1 Then
        For RowT = 1 To 9
            For ColumnT = 1 To 9
                If Sudoku_Games_Generator(RowT, ColumnT, 10) = kvadrant Then
                    If Sudoku_Games_Generator(RowT, ColumnT, 0) = värde Then unik = False
                    If Sudoku_Games_Generator(RowT, ColumnT, värde) = 1 Then
                        If Row = RowT And Column = ColumnT Then
                        Else
                            unik = False
                        End If
                    End If
                End If
            Next
        Next

        If unik = True Then
            Sudoku_Games_Generator(Row, Column, 0) = värde
            Check_Var = True
            For lups = 1 To 9
                Sudoku_Games_Generator(Row, Column, lups) = 0
            Next
        End If
  End If
Next

End Sub
'?!?!
Public Sub CheckR2IN(Sudoku_Games_Generator, Row, Column, Check_Var)

For värde = 1 To 9
    unik = True
    If Sudoku_Games_Generator(Row, Column, värde) = 1 Then
        For ColumnT = 1 To 9
            If Sudoku_Games_Generator(Row, ColumnT, 0) = värde Then
                unik = False
            End If
            If Sudoku_Games_Generator(Row, ColumnT, värde) = 1 Then
                If ColumnT <> Column Then
                    unik = False
                End If
            End If
        Next
        If unik = True Then
            Sudoku_Games_Generator(Row, Column, 0) = värde
            Check_Var = True
            For lups = 1 To 9
                Sudoku_Games_Generator(Row, Column, lups) = 0
            Next
        End If
    End If
Next

End Sub

Public Sub CheckC2IN(Sudoku_Games_Generator, Row, Column, Check_Var)

kvadrant = Sudoku_Games_Generator(Row, Column, 10)

For värde = 1 To 9
    unik = True
    If Sudoku_Games_Generator(Row, Column, värde) = 1 Then
        For RowT = 1 To 9
            If Sudoku_Games_Generator(RowT, Column, 0) = värde Then
                unik = False
            End If
            If Sudoku_Games_Generator(RowT, Column, värde) = 1 Then
                If RowT <> Row Then
                    unik = False
                End If
            End If
        Next
        If unik = True Then



            Sudoku_Games_Generator(Row, Column, 0) = värde
            Check_Var = True
            For lups = 1 To 9
                Sudoku_Games_Generator(Row, Column, lups) = 0
            Next
        End If
    End If
Next

End Sub

Public Sub Guess(Sudoku_Games_Generator, Check_Var, StartAllOver)

'identify best guess place

SlutSumma = 10
For Row = 1 To 9
    For Column = 1 To 9
        If Sudoku_Games_Generator(Row, Column, 0) = tom Then
            For lups = 1 To 9
                summa = summa + Sudoku_Games_Generator(Row, Column, lups)
            Next
            If summa < SlutSumma Then
                SlutRow = Row
                SlutColumn = Column
                SlutSumma = summa
            End If
            summa = 0
        End If
    Next
Next
'?!?!
If SlutSumma <> 0 Then
    'Random number between 1 and 9
    hittat = False
    While hittat = False
        Randomize
        tal = Int((9 * Rnd) + 1)
        If Sudoku_Games_Generator(SlutRow, SlutColumn, tal) = 1 Then
            hittat = True
            Sudoku_Games_Generator(SlutRow, SlutColumn, 0) = tal
            For lups = 1 To 9
                Sudoku_Games_Generator(SlutRow, SlutColumn, lups) = 0
                Check_Var = True
            Next
        End If
    Wend
Else
    Erase Sudoku_Games_Generator
    Check_Var = True
    Call ReadInData(Sudoku_Games_Generator)
    StartAllOver = StartAllOver + 1
    If StartAllOver > 1000 Then
        End
    End If
End If

End Sub

Public Sub CheckError(Sudoku_Games_Generator, ReStart, start)

Dim R(9)
Dim C(9)

For Value = 1 To 9
    For Row = 1 To 9
        Erase R
        For Column = 1 To 9
            If Sudoku_Games_Generator(Row, Column, 0) <> 0 Then
                R(Sudoku_Games_Generator(Row, Column, 0)) = R(Sudoku_Games_Generator(Row, Column, 0)) + 1
                If R(Sudoku_Games_Generator(Row, Column, 0)) > 1 Then ReStart = True
            End If
        Next
    Next
    For Column2 = 1 To 9
        Erase C
        For Row2 = 1 To 9
            If Sudoku_Games_Generator(Row2, Column2, 0) <> 0 Then
                C(Sudoku_Games_Generator(Row2, Column2, 0)) = C(Sudoku_Games_Generator(Row2, Column2, 0)) + 1
                If C(Sudoku_Games_Generator(Row2, Column2, 0)) > 1 Then ReStart = True
            End If
        Next
    Next
Next

End Sub



Public Sub CheckReady(Sudoku_Games_Generator, ER)

For Row = 1 To 9
    For Column = 1 To 9
        Summan = Summan + Sudoku_Games_Generator(Row, Column, 0)
        If Sudoku_Games_Generator(Row, Column, 0) <> tom Then
            Summan2 = Summan2 + 1
        End If
    Next
Next

If Summan = 405 And Summan2 = 81 Then
    ER = True
End If

End Sub

Public Sub EraseData(Sudoku_Games_Generator, EraseNumber)

While rounds <> (EraseNumber * 10)
    Randomize
    Row = Int((9 * Rnd) + 1)
    Randomize
    Column = Int((9 * Rnd) + 1)
    If Sudoku_Games_Generator(Row, Column, 0) <> tom Then
        Sudoku_Games_Generator(Row, Column, 0) = tom
        rounds = rounds + 1
    End If
Wend

End Sub

Stop and Wait While Executing VBA Code

This programs stops and waits for a few seconds in the middle of the execution of the VBA code.

Explanation

Sometimes it is useful to stop the coding for a few seconds due to processes that needs to be finalized that are not directly connected and in interaction with the VBA engine, thus will make the program crash if they are not finalized before executing the rest of the VBA program. For example if you have a program that you can execute through VBA macro but it is not fully integrated with excel thus you do not know when the other program has performed their processes. But you might know that the maximum time for finish is 10 seconds then you simply stop your VBA code for 10 seconds and then you can continue the code again!

Code

Public Sub

‘Stops the execution of the code and continues after 10 seconds.
 Application.Wait Now + TimeValue("00:00:10")

End sub