Change Click to Change event advice

[ipbr21054]

Evening,

I currently use this code shown below on a click command button.

Private Sub CommandButton1_Click()Dim CustomerName As String
Worksheets("DATABASE").Select
CustomerName = Range("A6")
Worksheets("INFO").Select
Worksheets("INFO").Range("CF2").Select
If Worksheets("INFO").Range("CF2").Offset(1, 0) <> "" Then
Worksheets("INFO").Range("CF2").End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = CustomerName
ActiveCell.Interior.ColorIndex = 6
ActiveCell.HorizontalAlignment = xlCenter
ActiveCell.VerticalAlignment = xlBottom
ActiveCell.VerticalAlignment = xlCenter
Selection.Borders.LineStyle = xlContinuous
ActiveCell.RowHeight = 19.5
ActiveCell.Font.Bold = True
Worksheets("DATABASE").Select
End Sub

I would like the code to run BUT i dont want to keep clicking the button so it needs to be a change event ??

I assume i need to add it to my currently used change event which is shown below.

Private Sub Worksheet_Change(ByVal Target As Range)    With Target
        If .Column = 13 Then Exit Sub
        If .Count = 1 And Not .HasFormula Then
            Application.EnableEvents = False
            .Value = UCase(.Value)
            Application.EnableEvents = True
        End If
    End With
End Sub

I tried like shown but as soon as you move anywhere on the sheet the code runs where i thought it would only rune once you leave cell A6

Private Sub Worksheet_Change(ByVal Target As Range)    With Target
        If .Column = 13 Then Exit Sub
        If .Count = 1 And Not .HasFormula Then
            Application.EnableEvents = False
            .Value = UCase(.Value)
            Application.EnableEvents = True
        Else
            Dim CustomerName As String
            Worksheets("DATABASE").Select
            CustomerName = Range("A6")
            Worksheets("INFO").Select
            Worksheets("INFO").Range("CF2").Select
            If Worksheets("INFO").Range("CF2").Offset(1, 0) <> "" Then
            Worksheets("INFO").Range("CF2").End(xlDown).Select
        End If
            ActiveCell.Offset(1, 0).Select
            ActiveCell.Value = CustomerName
            ActiveCell.Interior.ColorIndex = 6
            ActiveCell.HorizontalAlignment = xlCenter
            ActiveCell.VerticalAlignment = xlBottom
            ActiveCell.VerticalAlignment = xlCenter
            Selection.Borders.LineStyle = xlContinuous
            ActiveCell.RowHeight = 19.5
            ActiveCell.Font.Bold = True
            Worksheets("DATABASE").Select
        End If
    End With
End Sub

If im totally wrong & It needs to be something else please advise.
Thanks

 

[Norie]

If you only want the new code to run when a particular cell has changed you need to check that Target, the cell that has been changed, is that cell.

Sort of like how you are checking which column Target is in at the start of the original code in the Change event.

 

[ipbr21054]

I tried this before i posted but didnt work for me.

Private Sub Worksheet_Change(ByVal Target As Range)    With Target
        If .Column = 13 Then Exit Sub
        If .Count = 1 And Not .HasFormula Then
            Application.EnableEvents = False
            .Value = UCase(.Value)
            Application.EnableEvents = True
     Else
            If Target.Address(0, 0) <> "A6" Then Exit Sub
            If Target.Address("A6").Value Then
            Dim CustomerName As String
            Worksheets("DATABASE").Select
            CustomerName = Range("A6")
            Worksheets("INFO").Select
            Worksheets("INFO").Range("CF2").Select
            If Worksheets("INFO").Range("CF2").Offset(1, 0) <> "" Then
            Worksheets("INFO").Range("CF2").End(xlDown).Select
     End If
            ActiveCell.Offset(1, 0).Select
            ActiveCell.Value = CustomerName
            ActiveCell.Interior.ColorIndex = 6
            ActiveCell.HorizontalAlignment = xlCenter
            ActiveCell.VerticalAlignment = xlBottom
            ActiveCell.VerticalAlignment = xlCenter
            Selection.Borders.LineStyle = xlContinuous
            ActiveCell.RowHeight = 19.5
            ActiveCell.Font.Bold = True
           Worksheets("DATABASE").Select
            
        End If
    End With
End Sub

 

[ipbr21054]

I then changed it to the code below which doesnt give any errors but then it doesnt copy/paste to the INFO sheet either ha ha

Private Sub Worksheet_Change(ByVal Target As Range)    With Target
        If .Column = 13 Then Exit Sub
        If .Count = 1 And Not .HasFormula Then
            Application.EnableEvents = False
            .Value = UCase(.Value)
            Application.EnableEvents = True
     Else
            If Target.Address(0, 0) <> "A6" Then Exit Sub
            If Range("A6").Value Then
            Dim CustomerName As String
            Worksheets("DATABASE").Select
            CustomerName = Range("A6")
            Worksheets("INFO").Select
            Worksheets("INFO").Range("CF2").Select
            If Worksheets("INFO").Range("CF2").Offset(1, 0) <> "" Then
            Worksheets("INFO").Range("CF2").End(xlDown).Select
     End If
            ActiveCell.Offset(1, 0).Select
            ActiveCell.Value = CustomerName
            ActiveCell.Interior.ColorIndex = 6
            ActiveCell.HorizontalAlignment = xlCenter
            ActiveCell.VerticalAlignment = xlBottom
            ActiveCell.VerticalAlignment = xlCenter
            Selection.Borders.LineStyle = xlContinuous
            ActiveCell.RowHeight = 19.5
            ActiveCell.Font.Bold = True
           Worksheets("DATABASE").Select
            
        End If
        End If
    End With
    
End Sub