Move to right column after return when I press enter

[forerver]

Hi

I need small help.

I get this code from this forum. i need something to add the code for offset in the 2 column only. like this sample.
Screen Shot 2019-06-13 at 10.10.35 AM.jpg

only 2 columns (A and B). after I enter the name in Column C3 & D3 automatic return in C4 after I press the enter.

here the code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count <> "1" Or Target.Column <> 1 Or Target.Value = "" Then Exit Sub
    Dim wbpath      As String
    Dim photoPath   As String
    Dim wB          As Workbook
    Dim wS          As Worksheet
    Dim photoName   As String
    Dim photoFile   As String
    Dim Cell        As Range
    Dim rng         As Range
    Dim sh          As Shape
    
    Dim noPhoto     As String
    noPhoto = "NOPHOTO.jpg"
    
    Dim photoExt    As String
    photoExt = ".jpg"
    
    'Turn screen updating off. You won't see the client file being updated.
    Application.ScreenUpdating = False
    Set wB = ActiveWorkbook
    Set wS = wB.Worksheets("Sheet1")
    
   ' path to your folder
    wbpath = "G:\sample"
    ' the path to the folder witl aal the photos
   photoPath = "G:\sample\"
   
    Set Cell = Target
    If Not Cell.Column = 1 Or Len(Trim(Cell.Value)) = 0 Then Exit Sub
    photoName = Cell.Value
    Set rng = wS.Range("E" & Cell.Row)
    photoFile = photoName & photoExt
    GoSub placePhotoInSheet
    Err.Clear
    On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub
    
deleteAllShapes:
For Each sh In wS.Shapes
    sh.Delete
Next sh
Return
    
placePhotoInSheet:
On Error Resume Next
wS.Shapes(photoName).Select
If Err.Number = 1 Then
    wS.Shapes(photoName).Visible = msoTrue
    Return
End If
GoSub deleteAllShapes
rng.Select
If Not Dir(photoPath & photoFile) = "" Then
    ActiveSheet.Pictures.Insert(photoPath & photoFile).Select
ElseIf Not Dir(wbpath & noPhoto) = "" Then
    ActiveSheet.Pictures.Insert(wbpath & noPhoto).Select
ElseIf Not Dir(photoPath & noPhoto) = "" Then
    ActiveSheet.Pictures.Insert(photoPath & noPhoto).Select
Else
    Return
End If
With Selection.ShapeRange
    .Name = photoName
    .LockAspectRatio = msoTrue
    .Top = rng.Top
    .Left = rng.Left
    '.Width = 141.75
    .Height = 141.75
    .IncrementLeft 0.75
    .IncrementTop -130
End With

rng.Offset(1, -rng.Column + 1).Select
Return


End Sub

[Leith Ross]

Hello forever,

Here is the basic code to do this. Adapt it your your needs.

Private Sub Worksheet_Change(ByVal Target As Range)


        If Target.Cells.Count > 1 Then Exit Sub
        
        If Target.Column = 2 Then
            Application.EnableEvents = False
            Cells(Target.Row + 1, "A").Select
            Application.EnableEvents = True
        End If
        
End Sub

[forerver]

thanks Leith,

Anyway, I try to copy and paste but error result. see image below
Screen Shot 2019-06-17 at 5.04.55 PM.jpg

Please help me to arrange this code to run with pictures.

here the code with the code from you.

Private Sub Worksheet_Change(ByVal Target As Range)




       If Target.Cells.Count > 1 Then Exit Sub


       If Target.Column = 2 Then
           Application.EnableEvents = False
           Cells(Target.Row + 1, "A").Select
           Application.EnableEvents = True
       End If


End Sub
Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Count <> "1" Or Target.Column <> 2 Or Target.Value = "" Then Exit Sub
    Dim wbpath      As String
    Dim photoPath   As String
    Dim wB          As Workbook
    Dim wS          As Worksheet
    Dim photoName   As String
    Dim photoFile   As String
    Dim Cell        As Range
    Dim rng         As Range
    Dim sh          As Shape
    
    Dim noPhoto     As Stringa
    noPhoto = "NOPHOTO.jpg"
    
    Dim photoExt    As String
    photoExt = ".jpg"
    
    'Turn screen updating off. You won't see the client file being updated.
    Application.ScreenUpdating = False
    Set wB = ActiveWorkbook
    Set wS = wB.Worksheets("Sheet1")
    
   ' path to your folder
    wbpath = "G:\sample" & Application.PathSeparator
    ' the path to the folder witl aal the photos
    photoPath = "G:\sample\" & Application.PathSeparator
    
    Set Cell = Target
    If Not Cell.Column = 2 Or Len(Trim(Cell.Value)) = 0 Then Exit Sub
    photoName = Cell.Value
    Set rng = wS.Range("E" & Cell.Row)
    photoFile = photoName & photoExt
    GoSub placePhotoInSheet
    Err.Clear
    On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub
    
deleteAllShapes:
For Each sh In wS.Shapes
    sh.Delete
Next sh
Return
    
placePhotoInSheet:
On Error Resume Next
wS.Shapes(photoName).Select
If Err.Number = 1 Then
    wS.Shapes(photoName).Visible = msoTrue
    Return
End If
GoSub deleteAllShapes
rng.Select
If Not Dir(photoPath & photoFile) = "" Then
    ActiveSheet.Pictures.Insert(photoPath & photoFile).Select
ElseIf Not Dir(wbpath & noPhoto) = "" Then
    ActiveSheet.Pictures.Insert(wbpath & noPhoto).Select
ElseIf Not Dir(photoPath & noPhoto) = "" Then
    ActiveSheet.Pictures.Insert(photoPath & noPhoto).Select
Else
    Return
End If
With Selection.ShapeRange
    .Name = photoName
    .LockAspectRatio = msoTrue
    .Top = rng.Top
    .Left = rng.Left
    '.Width = 141.75
    .Height = 250
    .IncrementLeft 0.75
    .IncrementTop -200
End With
rng.Offset(1, -rng.Column + 2).Select
Return


End Sub

[大灰狼1976]

Hi forerver!
No process with the same name can occur. You need to merge the code.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count <> "1" Or Target.Column <> 2 Or Target.Value = "" Then Exit Sub
    Dim wbpath      As String
    Dim photoPath   As String
    Dim wB          As Workbook
    Dim wS          As Worksheet
    Dim photoName   As String
    Dim photoFile   As String
    Dim Cell        As Range
    Dim rng         As Range
    Dim sh          As Shape
    
    Dim noPhoto     As Stringa
    noPhoto = "NOPHOTO.jpg"
    
    Dim photoExt    As String
    photoExt = ".jpg"
    
    'Turn screen updating off. You won't see the client file being updated.
    Application.ScreenUpdating = False
    Set wB = ActiveWorkbook
    Set wS = wB.Worksheets("Sheet1")
    
   ' path to your folder
    wbpath = "G:\sample" & Application.PathSeparator
    ' the path to the folder witl aal the photos
    photoPath = "G:\sample\" & Application.PathSeparator
    
    Set Cell = Target
    If Not Cell.Column = 2 Or Len(Trim(Cell.Value)) = 0 Then Exit Sub
    photoName = Cell.Value
    Set rng = wS.Range("E" & Cell.Row)
    photoFile = photoName & photoExt
    GoSub placePhotoInSheet
    Err.Clear
    On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub
    
deleteAllShapes:
For Each sh In wS.Shapes
    sh.Delete
Next sh
Return
    
placePhotoInSheet:
On Error Resume Next
wS.Shapes(photoName).Select
If Err.Number = 1 Then
    wS.Shapes(photoName).Visible = msoTrue
    Return
End If
GoSub deleteAllShapes
rng.Select
If Not Dir(photoPath & photoFile) = "" Then
    ActiveSheet.Pictures.Insert(photoPath & photoFile).Select
ElseIf Not Dir(wbpath & noPhoto) = "" Then
    ActiveSheet.Pictures.Insert(wbpath & noPhoto).Select
ElseIf Not Dir(photoPath & noPhoto) = "" Then
    ActiveSheet.Pictures.Insert(photoPath & noPhoto).Select
Else
    Return
End If
With Selection.ShapeRange
    .Name = photoName
    .LockAspectRatio = msoTrue
    .Top = rng.Top
    .Left = rng.Left
    '.Width = 141.75
    .Height = 250
    .IncrementLeft 0.75
    .IncrementTop -200
End With
'rng.Offset(1, -rng.Column + 2).Select
If Target.Column = 2 Then Target.Offset(1, -1).Select
Return

End Sub