VBA code suddenly won't run

KlausW

KlausW

Active Member
Joined
Sep 9, 2020
Messages
379
Office Version
  1. 2016
Platform
  1. Windows
Hi
I am using this VBA-code to move item from one sheet to another, but I can't figure out why it suddenly won't run.

Any help will be appreciated
Best regards
Klaus W

VBA Code: 
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()

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, 1) <> "" 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

.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, 6).Value = .Bemærkning

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, 6).Value = .Bemærkning

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 = ""



Me.ComboBox1.Activate





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("A2" & Cell.row, "H" & Cell.row)

ClearOmråde .Range(rRække.Address)

GoTo Forfra

End If

Next Cell

End With

End Sub

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
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
KlausW said:
suddenly won't run
Click to expand...
Usually means some code was changed. What was the last change you made? Also, you have been around this forum long enough to know that vague descriptions like "won't run" are hard to diagnose.

Since everything begins in Private Sub worksheet_change(ByVal Target As Range), make sure that Application.Events did not become disabled. As a test, try executing Sub Prisliste_Overfør_Varer_Klik() manually instead of calling it from Private Sub worksheet_change(ByVal Target As Range)
 
Upvote 0
If you somehow disabled event procedures without turning them back on, your "Worksheet_Change" procedure will no longer run until that is reset.
You can either close out of Excel and then go back into it to reset it, or manually run this simple code:
VBA Code: 
Sub ReEnableEvents()
    Application.EnableEvents = True
End Sub
 
Upvote 0
rlv01 said:
Usually means some code was changed. What was the last change you made? Also, you have been around this forum long enough to know that vague descriptions like "won't run" are hard to diagnose.

Since everything begins in Private Sub worksheet_change(ByVal Target As Range), make sure that Application.Events did not become disabled. As a test, try executing Sub Prisliste_Overfør_Varer_Klik() manually instead of calling it from Private Sub worksheet_change(ByVal Target As Range)
Click to expand...
I see, I have inserted the vba code I have corrected and then it does not work. sorry Klaus W
You're right, I'm missing the explanation
 
Upvote 0
Hi again

The VBA code is used to move the item from the Prisliste sheet to the Bestilling sheet.

In Row 8 there is a header.

The items in the Prisliste sheet start at A9 and must be transferred to the Bestilling sheet from A9 onwards.

I've tried putting ' in front of some of the lines because I don't need to use the transfer of item with prices.

This has caused the items to be inserted into the Bestilling sheets above headings and not in A9 as it should.

Hope it makes sense

Best Regards

Klaus W

VBA Code: 
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()

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, 1) <> "" 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 = ""



Me.ComboBox1.Activate





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("A2" & Cell.row, "H" & Cell.row)

ClearOmråde .Range(rRække.Address)

GoTo Forfra

End If

Next Cell

End With

End Sub

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
 
Upvote 0
KlausW said:
I've tried putting ' in front of some of the lines because I don't need to use the transfer of item with prices.
This has caused the items to be inserted into the Bestilling sheets above headings and not in A9 as it should.
Hope it makes sense
Click to expand...

Studying your code, I do not see why commenting out those lines would cause the behavior you describe. But I am unable to compile or run your macros, so that limits my analysis.
 
Upvote 0
Thanks both of You, I close the Questions here an start a new one: Klaus W
 
Upvote 0
You must log in or register to reply here.

Similar threads

KlausW
  • Solved
Problems with VBA code
Replies
2
Views
294
KlausW
KlausW
KlausW
  • Solved
Help to move the cursor back to the Combobox
Replies
4
Views
587
KlausW
KlausW
KlausW
  • Question
VBA code does not run properly with formulas
Replies
0
Views
296
KlausW
KlausW
KlausW
  • Question
Return toCombobox
Replies
0
Views
246
KlausW
KlausW
KlausW
  • Solved
Run macro when enter "Enter" key
2
Replies
16
Views
942
Candyman8019
C

Forum statistics

Threads
1,215,080
Messages
6,123,013
Members
449,093
Latest member
ikke

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top