Move row to another sheet VBA is bugging for me

[pasjauo]

Hey guys,

I have found some different VBA codes and pieced it together to my current status.

I do have some problems. The row is moving based on the value of column G where "GODKENDT" will move the row. The problem is that not all rows work and sometimes I can close the file, reopen and then the code works. More often or not it works on row numbers below 15-ish but not over. But usually it bugs me so it doesn't work at all.

My code is the following:

[COLOR=#000000][FONT=Verdana]Private Sub Worksheet_Change(ByVal Target As Range)[/FONT][/COLOR][COLOR=#000000][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    Dim KeyCells As Range[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    Dim lastRow As Integer, lastRowOut As Integer, pasteRow As Integer[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    Dim wsÅbne As Worksheet, wsLøst As Worksheet[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    Set wsÅbne = ThisWorkbook.Sheets("Aktuelt")[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    Set wsLøst = ThisWorkbook.Sheets("Godkendt")[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    lastRow = wsÅbne.Cells(wsÅbne.Rows.Count, 2).End(xlUp).Row[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    ' The variable KeyCells contains the cells that will[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    ' cause an alert when they are changed.[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    Set KeyCells = wsÅbne.Range("G2:G" & lastRow)[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]        For i = 2 To lastRow[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]            lastRowOut = wsLøst.Cells(wsLøst.Rows.Count, 2).End(xlUp).Row[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]            [/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]            If lastRowOut = 1 Then[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]                pasteRow = 2[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]            Else[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]                pasteRow = wsLøst.Cells(wsLøst.Rows.Count, 2).End(xlUp).Row + 1[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]            End If[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]            If wsÅbne.Range("G" & i).Value = "GODKENDT" Then[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]                [/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]                wsÅbne.Range("A" & i & ":G" & i).Cut Destination:=wsLøst.Range("A" & pasteRow)[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]                wsÅbne.Rows(i).EntireRow.Delete[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]            End If[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]        Next i[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]       [/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    End If[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]End Sub[/FONT][/COLOR]

I really cant figure out what seems to be the problem to be honest. I have had small moments where it worked like a charm but even a look at the code (not touching it) can bug it.

Working on Office 365.

Thanks in advance.

 

[NdNoviceHlp]

You have the code in a worksheet change event and you are making changes to the sheet within the code which then triggers the code again. You need to add a Boolean to shut off the event until your code is done. Something like this (untested)…

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim KeyCells As Range
    Dim lastRow As Integer, lastRowOut As Integer, pasteRow As Integer
    Dim wsÅbne As Worksheet, wsLøst As Worksheet, Flag As Boolean
If Not Flag Then

    Set wsÅbne = ThisWorkbook.Sheets("Aktuelt")
    Set wsLøst = ThisWorkbook.Sheets("Godkendt")

    lastRow = wsÅbne.Cells(wsÅbne.Rows.Count, 2).End(xlUp).Row


    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = wsÅbne.Range("G2:G" & lastRow)
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Flag = True

        For i = 2 To lastRow


            lastRowOut = wsLøst.Cells(wsLøst.Rows.Count, 2).End(xlUp).Row

            If lastRowOut = 1 Then
                pasteRow = 2
            Else
                pasteRow = wsLøst.Cells(wsLøst.Rows.Count, 2).End(xlUp).Row + 1
            End If

            If wsÅbne.Range("G" & i).Value = "GODKENDT" Then

                wsÅbne.Range("A" & i & ":G" & i).Cut Destination:=wsLøst.Range("A" & pasteRow)
                wsÅbne.Rows(i).EntireRow.Delete


            End If


        Next i

    End If
Flag = False
End If
End Sub

HTH. Dave

 

[pasjauo]

You have the code in a worksheet change event and you are making changes to the sheet within the code which then triggers the code again. You need to add a Boolean to shut off the event until your code is done. Something like this (untested)…

HTH. Dave

Thanks Dave,

I just tested it out and it seems to work flawlessly. The rows that didnt work in the previous code didnt work either this time, but when i removed the rows and plottet in new ones that worked. So i guess these rows somehow bugged the code.

I will further test it today and tomorrow and hopefully it will just work!

 

[NdNoviceHlp]

Thanks for the update. I hate worksheet change. I use anything else if possible just because of these seemingly recursive errors where the code executes before the end of the coded sub? What's up with that? Dave

 

[pasjauo]

Thanks for the update. I hate worksheet change. I use anything else if possible just because of these seemingly recursive errors where the code executes before the end of the coded sub? What's up with that? Dave

Well to be honest i did have to use a copy/paste somewhere inside this forum in the first place, so this was what I started with. I'm not that much of an expert to know what I'm doing

 

[NdNoviceHlp]

pasjauo My apologies. My beef is with MS XL and/or my understanding of code compilation/execution. Happy to be of assistance if U need future help. Dave

 

[pasjauo]

pasjauo My apologies. My beef is with MS XL and/or my understanding of code compilation/execution. Happy to be of assistance if U need future help. Dave

Yeah no problem. Didnt see it as a personal insult I know that the language is kinda one of a kind