[VBA] set range find() -> finds wrong value

[dunnobe]

Hey all,

My first time posting on this forum.
I'm troubled by an annoying problem in my code.

My goal is to transpose some data from a vertical to a horizontal structure. A date is looked up in a datasheet and everytime it finds that date, it should copy a value next to it to my summary sheet. If it finds the date 2x, it should copy 2 cells etc.

Problem

The loop does something wrong when looking up dates. It tries to find a specific date, but copies the cells of a similar data.

Example of problem

It looks up the value 15/01/2016 from ws Summary in wsTime -> finds it -> copies a value (c(, 2).Copy) -> next find
It looks up the value 15/01/2016 from ws Summary in wsTime -> finds it -> copies a value (c(, 2).Copy) -> next find

-> should no longer find 15/01/2016 and go to next find (16/01/2016)
-> but problem occurs

It looks up the value 15/01/2016 from ws Summary in wsTime -> finds 15/11/2016 -> copies a value (c(, 2).Copy) -> next find
It looks up the value 15/01/2016 from ws Summary in wsTime -> finds 15/11/2016 -> copies a value (c(, 2).Copy) -> next find
It looks up the value 15/01/2016 from ws Summary in wsTime -> finds 15/11/2016 -> copies a value (c(, 2).Copy) -> next find
It looks up the value 15/01/2016 from ws Summary in wsTime -> finds 15/11/2016 -> copies a value (c(, 2).Copy) -> next find

->It no longer finds 15/01/2016 and goes to next find (16/01/2016)

It looks up the value 16/01/2016 from ws Summary in wsTime-> finds it...

Ironically it works fine when looking up and copying 15/11/2016... the problem only occurs if the data starts in January (01) or February (02) AND when the sheet also has data for November (11) and December (12).

' Create the data for column C till last in wsSummary
' ---------------------------------------------------
    Dim rng1 As Range, rng2 As Range, rng3 As Range, r As Range, c As Range, d As Range
    Dim ff As String, gg As String
    Set rng1 = wsSummary.Cells(1).CurrentRegion
    Set rng2 = wsTime.Cells(1).CurrentRegion.Columns("f")
    Set rng3 = wsPlanification.Cells(2).CurrentRegion.Columns("g")
    rng1.Offset(1, 4).ClearContents
    For Each r In rng1.Columns(1).Cells
        If IsDate(r.Value) Then
            Set d = rng3.Find(r.Value, , xlFormulas)
            If Not d Is Nothing Then
                    d(, 8).Copy r.Offset(, 2)
                    d(, 3).Copy r.Offset(, 3)
            Else
                r(, 3).Resize(, 2) = 0
            End If
            Set c = rng2.Find(r.Value, , xlFormulas)
            If Not c Is Nothing Then
                ff = c.Address
                Do
                    r(, 5) = r(, 5) + 1
'
'                    c(, 2).Copy r.Offset(, r(, 5) * 5)
'                    c(, 4).Copy r.Offset(, r(, 5) * 5 + 1)
'                    c(, 6).Copy r.Offset(, r(, 5) * 5 + 2)
'                    c(, 7).Copy r.Offset(, r(, 5) * 5 + 3)
'                    c(, 13).Copy r.Offset(, r(, 5) * 5 + 4)
                   
                   Union(c(, 2), c(, 4), c(, 6), c(, 7), c(, 13)).Copy r.Offset(, r(, 5) * 5)
                    Set c = rng2.FindNext(c)
                Loop Until c.Address = ff
            Else
                r(, 5) = 0
            End If
        End If
    Next

PS: special thanks to those who helped me make this code in the past. I'm quite new to VBA and I'm quite clueless right now...

Thanks!!!

 

[dunnobe]

The topic can be closed.

Set c = rng2.Find(r.Value, , xlFormulas, xlwhole)lookat:=xlWhole made the code look for exact matches.

Best regards,

dunnobe