Error in Workbook_SheetChange - infinite loop without reason

[wns10680]

I am new to Excel VBA, please anyone can help me check with the problem?
I am currently like to update the user name, which I stored in ThisWorkbook.Sheets("User").Range("M1"), once the sheet changes.
However, the code keep loop without ending from the red line below. Can anyone help explain what happen with my code?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim lRow As Long, lCol As Long, i As Integer, j As Integer
Dim name As String

On Error GoTo 0

If (Sh.name = "Summary" Or Sh.name = "Sample" Or Sh.name = "User") = False Then 'loop start from here

    lRow = Sh.Cells(Rows.Count, 1).End(xlUp).Row
    lCol = Sh.Cells(1, Columns.Count).End(xlToLeft).Column
    If Target <> "" Then

        Do While ThisWorkbook.Sheets("User").Range("M1") = ""
            MsgBox "Please enter your name."
            LoadUserForm
        Loop

        name = ThisWorkbook.Sheets("User").Range("M1")

        If name <> "" Then
    
            Sh.Range("Q"& Target.Row).Value =name  'the code after proceed this line keep loop back to the first If statement
            MsgBox name
       
        End If

    End If

End If

End Sub

 

[offthelip]

your code will loop continuously becuase this line:

Sh.Range("Q"& Target.Row).Value =name 'the code after proceed this line keep loop back to the first If statement

makes a change on the worksheet and thus triggers the workhseet change event again and again and ....
You need to inhibit the events handling before writing and restore it afterwards like this:

application.enableEvents=False
Sh.Range("Q"& Target.Row).Value =name 'the code after proceed this line keep loop back to the first If statement
application.enableEvents=True