Run macro when enter "Enter" key

[KlausW]

Hi

I have tried to get this VBA code located in the sheet Prisliste see image 1 to run when I press Enter in column C but without success, someone who can help. I have put this VBA code in sheet Denne_projekmappe. See picture 2

Any help will be appreciated.

Best regards Klaus W

Option Explicit
Dim wb As Workbook
Dim WsPris As Worksheet, WsBestil As Worksheet
Dim rPris As Range, rBestil As Range

Private Sub SetVar()
Set wb = ActiveWorkbook
Set WsPris = wb.Sheets("Prisliste")
Set WsBestil = wb.Sheets("Bestilling")
Set rPris = WsPris.Range("A9", WsPris.Range("A5000").End(xlUp))
Set rBestil = WsBestil.Range("A9", WsBestil.Range("A5000").End(xlUp).Offset(5, 0))
End Sub

'Sub Prisliste_Overfør_Varer_Klik()
    
 Sub MyCode()
    
    Application.ScreenUpdating = False
    SetVar
    Dim col As New Collection
    Dim Varelinje As New ClVarelinjer
    Dim vElement
    Dim Cell As Range, iCell As Range
    For Each Cell In rPris
        If Cell.Offset(0, 2) <> "" Then
            With Varelinje
                 .Vare_nr = Cell.Value
                 .Navn = Cell.Offset(0, 1).Value
                 .Antal = Cell.Offset(0, 2).Value
                 .Enhed = Cell.Offset(0, 4).Value
                 .Pris = Cell.Offset(0, 5).Value
                 .Bemærkning = Cell.Offset(0, 10).Value
            End With
        Else
            GoTo Videre
        End If
        For Each iCell In rBestil
            With Varelinje
                If iCell.Value = .Vare_nr Then
                    iCell.Value = .Vare_nr
                    iCell.Offset(0, 1).Value = .Navn
                    iCell.Offset(0, 2).Value = .Antal
                    iCell.Offset(0, 4).Value = .Enhed
                    iCell.Offset(0, 5).Value = .Pris
                    iCell.Offset(0, 5).NumberFormat = "$ #,##0.00"
                    iCell.Offset(0, 6).Value = .Bemærkning
                    iCell.Offset(0, 7).FormulaR1C1 = "=IFERROR(RC[-5]*RC[-2],"""")"
                    iCell.Offset(0, 7).NumberFormat = "$ #,##0.00"
                    GoTo Videre
                ElseIf iCell.Value = "" Then
                    iCell.Value = .Vare_nr
                    iCell.Offset(0, 1).Value = .Navn
                    iCell.Offset(0, 2).Value = .Antal
                    iCell.Offset(0, 4).Value = .Enhed
                    iCell.Offset(0, 5).Value = .Pris
                    iCell.Offset(0, 5).NumberFormat = "$ #,##0.00"
                    iCell.Offset(0, 6).Value = .Bemærkning
                    iCell.Offset(0, 7).FormulaR1C1 = "=IFERROR(RC[-5]*RC[-2],"""")"
                    iCell.Offset(0, 7).NumberFormat = "$ #,##0.00"
                    GoTo Videre
                End If
            End With
        Next
Videre:
        Set Varelinje = New ClVarelinjer
    Next Cell
    Cbox
    'renser antal og bemærkning i prislisten
    ClearOmråde WsPris.Range("C9", WsPris.Range("C6000").End(xlUp))
    ClearOmråde WsPris.Range("K9", WsPris.Range("K6000").End(xlUp))
    '
    Slet_række
    ' sorterer
    Sorter WsBestil.Range("A9", WsBestil.Range("H6000").End(xlUp)), WsBestil.Range("B9", WsBestil.Range("B6000").End(xlUp))
    WsPris.Range("a1").Value = Now()
    ' sætter kanter
    IngenKanter WsBestil, WsBestil.Range("a9", WsBestil.Range("H6000"))
    Kanter WsBestil, WsBestil.Range("a9", WsBestil.Range("H6000").End(xlUp))
    WsPris.Activate
    Application.ScreenUpdating = True
End Sub

Private Sub Cbox()
Dim fCbox As ComboBox
Set fCbox = ComboBox1
fCbox.Value = ""
End Sub

Private Sub Slet_række()
    Dim ColC As Range
    Dim rRække As Range
    Dim Cell As Range
Forfra:
    With WsBestil
        Set ColC = .Range("C9", .Range("C6000").End(xlUp))
        For Each Cell In ColC
            If Cell.Value = 0 And Cell.Value <> "" Then
                .Activate
                Set rRække = .Range("A" & Cell.row, "H" & Cell.row)
                ClearOmråde .Range(rRække.Address)
                GoTo Forfra
            End If
        Next Cell
    End With
End Sub

Option Explicit

Private Sub Workbook_Open()
    'VelKommen.Show
    Application.OnKey "{ENTER}", "SubMyCode"
    
End Sub

 

[rlv01]

I believe Application.OnKey "{ENTER}" only works for the Enter key on the numeric keypad, not for the Enter key on the main keyboard. Is that what you intended?

 

[KlausW]

I believe Application.OnKey "{ENTER}" only works for the Enter key on the numeric keypad, not for the Enter key on the main keyboard. Is that what you intended?

Ok I try. KW

 

[Candyman8019]

I feel like that is going to trigger anytime you press ENTER...not just on column C. You may want to try a worksheet change event on your Prisliste sheet, such as the following:

Private Sub worksheet_change(ByVal target As Range)

If Not Intersect(target, Sheets("Prisliste").Range("C2:C20000")) Is Nothing Then
  ' do something
End If
End Sub

This way, any time someone enters anything in column C, it will trigger your code.

 

[KlausW]

I feel like that is going to trigger anytime you press ENTER...not just on column C. You may want to try a worksheet change event on your Prisliste sheet, such as the following:

Private Sub worksheet_change(ByVal target As Range)

If Not Intersect(target, Sheets("Prisliste").Range("C2:C20000")) Is Nothing Then
  ' do something
End If
End Sub

This way, any time someone enters anything in column C, it will trigger your code.

 

[KlausW]

Hi Candyman8019​

I can't get it to work, I've tried putting the macro you sent into a module, and I've also tried putting it into sheet Denne_projekmappe. But it cannot find the macro Sub Price Prisliste_Overfør_Varer_Klik().

I change the macro like this.

KlausW

Private Sub worksheet_change(ByVal target As Range)

If Not Intersect(target, Sheets("Prisliste").Range("C9:C4000")) Is Nothing Then

Call Prisliste_Overfør_Varer_Klik

End If

End Sub

 

[Candyman8019]

If you want to trigger on column C of Prisliste then this needs to go into the Priceliste sheet.

And where is Sub Price Prisliste_Overfør_Varer_Klik()…is that in a module?

 

[KlausW]

No it is in the sheet Prisliste

 

[Candyman8019]

Then if you put worksheet_change script in priceliste as well, it should work.

 

[KlausW]

When I run the macro from the VBA editor, this is displayed see picture. An then I can run the marco Ark1.Prisliste_Overfør_Varer_Klik (Ark1 is the same as Sheet1 in English) But I do not have a Sheet1.
An the marco Ark1.Prisliste_Overfør_Varer_Klik running well.