VBA-kode kører ikke korrekt med formler
HejJeg har fået denne VBA-kode af en god ven her i forummet, den bruges til at flytte varen fra Prisliste-arket til Bestilling-arket.
Varerne i Prisliste-arket starter ved A9, i række 8 er en overskrift.
Varerne skal overføres til Bestillings arket fra A9 og nedefter, her er også en overskrift I Række 8.
Det fungerer upåklageligt, indtil jeg indsætter formler i Bestilling arket, for at søge efter information i et andet ark. Når der er sat formler i arket Bestilling flyttes varerne over overskriften i Række 8.
Hvis jeg ikke indsætter formel i Bestilling-arket virker det som det skal.
Al hjælp vil blive værdsat
Med venlig hilsen
Klaus W
https://1drv.ms/f/s!AmLaaGiC5LdoidAEVTDwya0qDXlhRA?e=PhECqX
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("A8", WsPris.Range("A5000").End(xlUp))
Set rBestil = WsBestil.Range("A8", 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, 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, 4).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("A8", WsBestil.Range("g6000").End(xlUp)), WsBestil.Range("B9", WsBestil.Range("B6000").End(xlUp))
WsPris.Range("a1").Value = Now()
' sætter kanter
IngenKanter WsBestil, WsBestil.Range("a8", WsBestil.Range("g6000"))
Kanter WsBestil, WsBestil.Range("a8", WsBestil.Range("g6000").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("A" & 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
