CODEWITHSUNDEEP
excelvbaexcel-2010
Steve Put
Steve Put

Reputation: 41

VBA move row based on multiple columns

I'm trying to move a row based on date to another sheet. The code works and the row moves correctly, but only when all the fields are filled in with a date.

  1. I also want to move the row when one or more fields are empty, so it only checks the columns that have a date filled in between the range F-H.
  2. Is tere a way to add all the columns that need to be checked in one line of code? Instead of hardcoding every column?

Code below. Thanks in advance.

        Sub MoveBasedOnValue5()
        lastrowcurrent = Sheets("Verlopen Keuring").Range("A" & Rows.Count).End(xlUp).Row
        lastrowpost = Sheets("Afgehandeld").Range("A" & Rows.Count).End(xlUp).Row
        For x = lastrowcurrent To 2 Step -1
        If Sheets("Verlopen keuring").Range("F" & x) >= Date And Sheets("Verlopen keuring").Range("G" & x) >= Date And Sheets("Verlopen keuring").Range("H" & x) >= Date Then
        Sheets("Verlopen keuring").Range("A" & x).EntireRow.Cut Sheets("Afgehandeld").Range("A" & lastrowpost + 1)
        Sheets("Verlopen keuring").Range("A" & x).EntireRow.Delete
        lastrowpost = lastrowpost + 1
    End If
Next
End Sub

Upvotes: 2

Views: 48

Answers (3)

CDP1802
CDP1802

Reputation: 16322

Option Explicit

Sub MoveBasedOnValue5()

    Dim rngTo As Range, c As Range
    Dim lastrowcurrent As Long, n As Long, r As Long
    
    With Sheets("Afgehandeld")
        Set rngTo = .Range("A" & .Rows.Count).End(xlUp)
    End With
    
    With Sheets("Verlopen keuring")
        lastrowcurrent = .Range("A" & .Rows.Count).End(xlUp).Row
        For r = lastrowcurrent To 2 Step -1
            
            For Each c In .Range("F:H").Columns
            ' add more columns like this
            'For Each c In .Range("F:H,J:L,O:O").Columns
            
               If c.Rows(r) >= Date Then
                  Set rngTo = rngTo.Offset(1)
                  .Rows(r).Copy rngTo
                  .Rows(r).Delete
                  n = n + 1
                  Exit For
               End If
            Next
            
        Next
    End With
    MsgBox n & " rows moved"
    
End Sub

Upvotes: 0

Vlado Bošnjaković
Vlado Bošnjaković

Reputation: 21

You should use OR IsEmpty():

Sub MoveBasedOnValue5()
    lastrowcurrent = Sheets("Verlopen Keuring").Range("A" & Rows.Count).End(xlUp).row
    lastrowpost = Sheets("Afgehandeld").Range("A" & Rows.Count).End(xlUp).row
    For x = lastrowcurrent To 2 Step -1
        If (Sheets("Verlopen keuring").Range("F" & x) >= Date Or IsEmpty(Sheets("Verlopen keuring").Range("F" & x)) _
            And (Sheets("Verlopen keuring").Range("G" & x) >= Date Or IsEmpty(Sheets("Verlopen keuring").Range("G" & x))) _
            And (Sheets("Verlopen keuring").Range("H" & x) >= Date Or IsEmpty(Sheets("Verlopen keuring").Range("H" & x)))) Then
                Sheets("Verlopen keuring").Range("A" & x).EntireRow.Cut Sheets("Afgehandeld").Range("A" & lastrowpost + 1)
                Sheets("Verlopen keuring").Range("A" & x).EntireRow.Delete
                lastrowpost = lastrowpost + 1
        End If
    Next
End Sub

Just make sure to add proper logic if all three cells F,G and H are empty.

This will be the same functionality:

Sub MoveBasedOnValue6()
    lastrowcurrent = Sheets("Verlopen Keuring").Range("A" & Rows.Count).End(xlUp).row
    lastrowpost = Sheets("Afgehandeld").Range("A" & Rows.Count).End(xlUp).row
    For x = lastrowcurrent To 2 Step -1
        If Not ((Sheets("Verlopen keuring").Range("F" & x) < Date) Or (Sheets("Verlopen keuring").Range("G" & x) < Date) Or (Sheets("Verlopen keuring").Range("H" & x) < Date)) Then
                Sheets("Verlopen keuring").Range("A" & x).EntireRow.Cut Sheets("Afgehandeld").Range("A" & lastrowpost + 1)
                Sheets("Verlopen keuring").Range("A" & x).EntireRow.Delete
                lastrowpost = lastrowpost + 1
        End If
    Next
End Sub

Upvotes: 0

Black cat
Black cat

Reputation: 6271

You can use the EVALUATE for worksheet functions something like this:

If Evaluate("=if(or('Verlopen keuring'!F" & x & ":H" & x & ">=Now()),true,false)") Then

Upvotes: 0

Related Questions