In need of some help modifying a function (already written)

[Hyflex]

Hey,

I'm looking for some help editing this macro, it's fairly hard to explain but should be fairly easy to change/fix I hope.

Basically, I need the macro instead of copying from first row(s) it finds for it to copy from 3 rows down from the first row it finds (offset of 3) but when it's retreiving the data back it needs to put it back in it's original place so it needs to detect the fact it's left 3 rows of data out when it copies...

Function COPYDATA(ByVal varFind As Variant, ByVal wsDest As Worksheet)
    
    Dim rngCopy As Range
    Dim rngFound As Range
    Dim strFirst As String
    Dim lRow As Long
    
    With Sheets("Sheet1").Columns("A")
        Set rngFound = .Find(varFind, .Cells(.Cells.Count), xlValues, xlWhole)
        If Not rngFound Is Nothing Then
            strFirst = rngFound.Address
            Set rngCopy = rngFound.CurrentRegion.Resize(rngFound.CurrentRegion.Rows.Count + 1).EntireRow
            Do
                Set rngCopy = Union(rngCopy, rngFound.CurrentRegion.Resize(rngFound.CurrentRegion.Rows.Count + 1).EntireRow)
                Set rngFound = .Find(varFind, rngFound, xlValues, xlWhole)
            Loop While rngFound.Address <> strFirst
            
            lRow = WorksheetFunction.Max(wsDest.Cells(Rows.Count, "A").End(xlUp).Row + 2, 16)
            rngCopy.Copy wsDest.Cells(lRow, "A")
            
            Set rngFound = Nothing
            Set rngCopy = Nothing
        End If
    End With
    
End Function

Function RETRIEVEDATA(ByVal varFind As Variant, ByVal wsSrc As Worksheet)
    
    Dim rngDest As Range
    Dim rngFound As Range
    Dim strFirst As String
    
    Set rngDest = Sheets("Sheet1").Columns("A").Find(varFind, Sheets("Sheet1").Cells(Rows.Count, "A"), xlValues, xlWhole)
    Set rngFound = wsSrc.Columns("A").Find(varFind, wsSrc.Cells(Rows.Count, "A"), xlValues, xlWhole)
    
    If Not rngFound Is Nothing Then
        strFirst = rngFound.Address
        Do
            rngFound.CurrentRegion.EntireRow.Copy rngDest.Offset(-1)
            Set rngFound = wsSrc.Columns("A").Find(varFind, rngFound, xlValues, xlWhole)
            Set rngDest = Sheets("Sheet1").Columns("A").Find(varFind, rngDest, xlValues, xlWhole)
        Loop While rngFound.Address <> strFirst
        Set rngDest = Nothing
        Set rngFound = Nothing
    End If
    
End Function

[Hyflex]

Anyone able to help?

[Norie]

Which of the 2 functions is it that needs changed?

Have you tried using Offset?

[Hyflex]

Hey,

I've tried to use offsets but can't figure out why it wont work.

See the example attached for example data and an example macro, I've included a text box with some more instructions.

[Hyflex]

Hey,

Anyone able to assist me further?

I'd much appreciate the help.

[Hyflex]

Bump, anyone able to assist?

Thanks
- Hyflex

[Norie]

I'm sorry but it really isn't clear what you want to do.

You could alter the code that finds the ranges to copy so that it only includes the data and not the headers, see below, but I don't understand the retrieving data part.

Function COPYDATA(ByVal varFind As Variant, ByVal wsDest As Worksheet)
    
    Dim rngCopy As Range
    Dim rngFound As Range
    Dim strFirst As String
    Dim lRow As Long
    
    With Sheets("main").Columns("A")
        Set rngFound = .Find(varFind, .Cells(.Cells.Count), xlValues, xlWhole)
        If Not rngFound Is Nothing Then
            strFirst = rngFound.Address

            Do
                If rngCopy Is Nothing Then
                            Set rngCopy = rngFound.CurrentRegion.Offset(3)
                            Set rngCopy = rngCopy.Resize(rngCopy.Rows.Count - 3)
                Else
                    Set rngCopy = Union(rngCopy, rngFound.CurrentRegion.Offset(3).Resize(rngFound.CurrentRegion.Rows.Count - 3))
                End If
                
                Set rngFound = .Find(varFind, rngFound, xlValues, xlWhole)
            Loop While rngFound.Address <> strFirst
            
            lRow = WorksheetFunction.Max(wsDest.Cells(Rows.Count, "A").End(xlUp).Row + 2, 16)
            rngCopy.Copy wsDest.Cells(lRow, "A")
            
            Set rngFound = Nothing
            Set rngCopy = Nothing
        End If
    End With
    
End Function

By the way, why do you want to copy the data, run some code on what's been copied and then transfer back?

Isn't it possible to work on the data in situ?

[Hyflex]

Hey Norie,

It's quite hard to explain but for the copy part you've understood it perfectly, to only copy the data and not the headers, for the retrieving part I can now see a problem moving it back... there is no identifying header to copy it back...

You're correct it is possible to work on the data in situ, but the amount of changes I make and differences between the lists make it extremely difficult to work on.

For the retreive part, usually it would use the headers but as there aren't would you be able to help by modifying that code to check using the first person and second persons name and if both match then copy it back in leaving the headers in tact

So the only thing being moved around is the data, I understand this is a rather unusual request as it seems somewhat pointless, If I was able to show you my actual document you'd understand but it's too big for the forum and has some confidential information in it.

[Norie]

Identifying where to return the data is a big problem especially when you are copying a whole bunch of non-contiguous data.

Is it possible to work with one 'block' of data at a time?

For example take the data for 'test1' from rows 19-24, work on that and then return it to that range.

You should be able to identify where to return the data to using rngFound.

Is there no way you could mock up something with representative data?

PS Is there a reason you can't copy the headers?

[Hyflex]

Hey,

Thanks for replying, unfortunately it's not possible to work on one dataset at a time.

I've tried to start modifying the retreive data part but the first macro what you edited isn't actually working right, the first bit of data which is 9 rows, but only 6 rows of data is being turned into 9 rows of data

Function RETRIEVEDATA(ByVal varFind As Variant, ByVal wsSrc As Worksheet)
    
    Dim rngDest As Range
    Dim rngFound As Range
    Dim strFirst As String
    
    Set rngDest = Sheets("main").Columns("A").Find(varFind, Sheets("main").Cells(Rows.Count, "A"), xlValues, xlWhole).Offset(2, 0)
    Set rngFound = wsSrc.Columns("A").Find(rngDest, wsSrc.Cells(Rows.Count, "A"), xlValues, xlWhole)
    
    If Not rngFound Is Nothing Then
        strFirst = rngFound.Address
        Do
            rngFound.CurrentRegion.EntireRow.Copy rngDest.Offset(0)
            Set rngFound = wsSrc.Columns("A").Find(varFind, rngFound, xlValues, xlWhole)
            Set rngDest = Sheets("main").Columns("A").Find(varFind, rngDest, xlValues, xlWhole)
        Loop While rngFound.Address <> strFirst
        Set rngDest = Nothing
        Set rngFound = Nothing
    End If
    
End Function

I'm attempting to match the first person's name (I'll have to add another check for the second persons name aswell just to make sure.

The reason I can't copy headers is because of all my conditional formatting and it's also easier formula wise.

The data respresented is as close as I can give, it follows pretty much the same structure as my own sheets excluding formula's

[Norie]

I changed the COPYDATA code to only copy the 6 rows of data, which is what you wanted isn't it?

That's all I changed.

Not sure what you mean about conditional formatting preventing the inclusion of the headers.

What conditional fomatting are you referrring to?

What exactly are you doing with the data anyway?

[Hyflex]

Hey Norie,

Yes that is what I wanted but it didn't seem to work correctly the 9 rows for the first race is not coming out as 6 rows (-3 for the headers to be removed), but it's coming out as 9...

In regards to the conditional formatting, we have a LOT of conditional formatting which plays havoc with the headers, it's an excel 2003 compatibility issue, this is the only way around it without having to re-write a lot of stuff.

The data gets changed and edited then I want it to go back to it's original places.


I could potentially do it a different way.
1) Use my old functions to edit the data
2) Use a new function what copies each dataset (only the data) into the sheet's like you did, then instantly copying it back. They will still have to be put into the new sheet one by one, but can be copied back as soon as they go into the sheet

Does that make sense?