3

I'm trying to get a date checked against a list of dates and if found I need to shuffle a value from one column across to another on the same row.

The below is what I started doing, which works but I'm sure this is a cleaner way to look up against a list?

Sub Date_Check()

Dim lw As Long
Dim c As Range
Dim myDate, myDate1, myDate2, myDate3 As Date

myDate = Sheets("Cover").Range("G8")
myDate1 = Sheets("Cover").Range("G9")
myDate2 = Sheets("Cover").Range("G10")

lw = Range("A" & Rows.count).End(xlUp).Row

For Each c In Range("A1:A" & lw)
    If c = myDate Or c = myDate1 Or c = myDate2 Or c = myDate3 Then
        c.Offset(0, 6).Cut
        c.Offset(0, 9).Activate
        ActiveSheet.Paste
    End If
Next c

End Sub

I've search to see what I can find and see array being reference but I'm unsure how this works correctly?

Any guidance would be greatly appreciated.

Thank you.

Community
  • 1
  • 1
Morallis
  • 151
  • 2
  • 15
  • Which sheet are you cutting from and where are you pasting? Also which sheet is `Range("A1:A" & lw)` in? – Siddharth Rout Nov 26 '13 at 14:24
  • Sorry, the Sheet I'm working off of is "WorkingSheet" `Sheets("WorkingSheet").Range("A1:A" & lw)` – Morallis Nov 26 '13 at 14:28
  • Be careful when doing an exact compare using date datatypes. Better to convert to strings and use resolution needed or use DataDiff() with the resolution you need. No so important if you generate the dates you are comparing. – rheitzman Nov 26 '13 at 15:40

1 Answers1

4

Three things that I can suggest as an improvement.

  1. Declare all your variables correctly. For example, consider this line Dim myDate, myDate1, myDate2, myDate3 As Date. In vba, only the last variable will be declared as a Date. Rest will be declared as Variants

  2. You can use Select Case instead of IF

  3. You don't need to use .Select/Activate to cut and paste. The entire operation can be done in one line. INTERESTING READ

Is this what you are trying (TESTED)

Sub Date_Check()
    Dim lw As Long
    Dim c As Range
    Dim myDate As Date, myDate1 As Date
    Dim myDate2 As Date, myDate3 As Date
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("WorkingSheet")

    myDate = ThisWorkbook.Sheets("Cover").Range("G8")
    myDate1 = ThisWorkbook.Sheets("Cover").Range("G9")
    myDate2 = ThisWorkbook.Sheets("Cover").Range("G10")

    With ws
        lw = .Range("A" & .Rows.Count).End(xlUp).Row

        For Each c In .Range("A1:A" & lw)
            Select Case c.Value
            Case myDate, myDate1, myDate2, myDate3
                c.Offset(0, 6).Cut c.Offset(0, 9)
            End Select
        Next c
    End With
End Sub

FOLLOWUP FROM COMMENTS

I need to reference around 30 dates

Something like this (TESTED)

Sub Date_Check()
    Dim lw As Long, i As Long
    Dim c As Range
    Dim myDate(1 To 30) As Date
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("WorkingSheet")

    For i = 8 To 37
        myDate(i - 7) = ThisWorkbook.Sheets("Cover").Range("G" & i)
    Next i

    With ws
        lw = .Range("A" & .Rows.Count).End(xlUp).Row

        For Each c In .Range("A1:A" & lw)
            For i = 1 To 30
                Select Case c.Value
                Case myDate(i)
                    c.Offset(0, 6).Cut c.Offset(0, 9)
                    Exit For
                End Select
            Next i
        Next c
    End With
End Sub
Community
  • 1
  • 1
Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
  • Thanks for the suggestions and updated code, this works like a charm. Is there a way to reference several dates within the case statement without having to declare each as a separate 'myDate' ? I need to reference around 30 dates. – Morallis Nov 26 '13 at 14:39
  • 1
    Thanks, this is awesome. I still have a lot to learn :) I updated your post to confirm I've tested the code, as well as making a small edit on the last update to update the second reference of `For i` to show `1 to 30` as this references `myDate` which is `1 to 30` - Thanks again – Morallis Nov 26 '13 at 15:03
  • @Morallis: I saw and approved the edit that you made to my post. I am glad it is now working for you :) – Siddharth Rout Nov 26 '13 at 15:04