Retrieving comments and keeping formats

[sharpdog]

I posted this a few days ago and didn't recieve any help, so I am going to attemt to re-phrase.

I am looking for a way to lookup values and comments from another sheet within the workbook. I thought I could use a UDF, but I now understand it must be VBA. I have no idea where to start with code for this. The best I can do is record a macro for a vlookup, but I don't know how to modify it to include paste special, or something like that.

Could someone give me a little help here?

Thanks,
Luke

 

[AlphaFrog]

The description of your problem is still quite vague.

Try recording a macro using the Edit\ Find function (Ctrl+F). You'll still have to edit the recorded macro, but it's a start.

 

[sharpdog]

Thanks for the response AF. I will attempt to improve the discription.

Luke

 

[sharpdog]

Hello, Here is what I have,

My workbook has 2 sheets: "Edit Schedule", and "View Schedule".

"Edit Schedule" - contains all the data, formatting, and comments. Everything in the workbook is referenced off of "Edit Schedule", except one cell a user can enter in a date.
In "Edit Schedule", the array "Dates" is in column C, and "Names" is in Row 5.

"View Schedule" - is populated with references to "Edit schedule" to aquire the names into Column A, and dates into row 4. Dates in "View Schedule" begin with the first user entry, then continue with that date+1 for the rest of the cells in row 4.

I have successfully got =ADDRESS(MATCH(B$4,Dates,0)+4,MATCH($A6,Names,0)+2) to return the lookup cell reference for 'View Schedule'!B6. It Returns $E$376 from "Edit Schedule".

That is what I have, here is what I want:

I would like code that will take the result of the =Address(Match.... formula, copy and paste special (all except boarders) into the 'View Schedule'!B6 cell.

Hopefully this will deliver a result the same as =vlookup, but also copy the formats and comments.

Here is a sample of what I am thinking for code. I know its way wrong, but hopefully you get the idea.

Sub CopyTest()

    Range().Copy
    
 'Range() filled with Worksheet function =ADDRESS(MATCH(B$4,Dates,0)+4,MATCH($A6,Names,0)+2))

     ' will return $E$376 to cell   'View Schedule'!B6
  

    Range("'View Schedule'!B6").PasteSpecial (xlPasteAllExceptBorders)
    

Application.CutCopyMode = False

' Repeat for all the other cells where lookups are done: B6:AT25, B30:AT49, B54:AT73

End Sub

If we can get this to work, I would like to repeat the same procedure from B6:AT25, then B30:AT49, and finally B54:AT73

Please request clarity where required, if this doesn't make any sense to you let me know and I will attempt to clarify.

Thanks in advance,
Luke

 

[AlphaFrog]

This copies everything including borders and then erases the copied borders. Not exactly what you asked for but this way was easy.

Sub Copy_Addresses_wo_Borders()
    
    Dim cel As Range, rng As Range, i As Integer
    
    Set rng = Sheets("View Schedule").Range("B6:AT25, B30:AT49, B54:AT73")
    
    Application.ScreenUpdating = False
    For Each cel In rng
        If cel.Value <> "" Then
            Sheets("Edit Schedule").Range(cel.Value).Copy Destination:=cel
        End If
    Next cel
    ' Erase copied borders
    For i = 5 To 12
        rng.Borders(i).LineStyle = xlNone
    Next i
    Application.ScreenUpdating = True
    MsgBox "Copy complete"
    
End Sub

The macro could probably do the Address-Match calculations instead of using the formulas.

 

[sharpdog]

Thanks AF!

That code works great when all cells are filled with the =address(match... formula.

Once the code is run and the data is copied and pasted, if I make changes to the origional data and run the macro again to update "View Schedule", it fails right away. Is there a way to include the =address(match...formula into the code?

Luke

 

[sharpdog]

AF, I see from the bottom of your post you expected my problem...

The formula in B6 is =ADDRESS(MATCH(B$4,Dates,0)+4,MATCH($A6,Names,0)+2)
The forumla in C6 is =ADDRESS(MATCH(C$4,Dates,0)+4,MATCH($A6,Names,0)+2)
The formula in B7 is =ADDRESS(MATCH(B$4,Dates,0)+4,MATCH($A7,Names,0)+2)

This is consistant through to AT25,

Then starting at B30
the formula is =ADDRESS(MATCH(B$28,Dates,0)+4,MATCH($A30,Names,0)+2)

Then at B54
the formula is =ADDRESS(MATCH(B$52,Dates,0)+4,MATCH($A30,Names,0)+2)

How would these be implemented into VBA?

It looks like all this lookup, copy, paste takes alot of horsepower. Takes about 30 seconds to run the code. This isn't a show stopper, but I just thought I would ask if this is normal.

Thanks,
Luke

 

[AlphaFrog]

30 seconds seems slow but I don't have your data to test.

Sub Copy_Lookups_wo_Borders()
    
    Dim cel As Range, rng As Range, i As Integer
    Dim adr As Variant, t As Single
    
    t = Timer
    
    Application.ScreenUpdating = False
    With Sheets("View Schedule")
        Set rng = .Range("B6:AT25, B30:AT49, B54:AT73")
        For Each cel In rng
            '=ADDRESS(MATCH(B$4,Dates,0)+4,MATCH($A6,Names,0)+2)
            adr = Evaluate("ADDRESS(MATCH(" & Cells(4, cel.Column).Address & ",Dates,0)+4,MATCH(A" & cel.Row & ",Names,0)+2)")
            If Not IsError(adr) Then
                Sheets("Edit Schedule").Range(adr).Copy Destination:=cel
            End If
        Next cel
        ' Erase copied borders
        For i = 5 To 12
            rng.Borders(i).LineStyle = xlNone
        Next i
    End With
    
    Application.ScreenUpdating = True
    MsgBox "Copy complete" & vbCr & Format(Timer - t, "0.00 seconds")
    
End Sub

 

[sharpdog]

Bingo, that is the ticket!

I will see if I can add a few small things into the macro such as replace the boarders how they started, and diesect your code so I can learn from it. Ran at 22 seconds, and 15 seconds in the last 2 attempts.

Thanks for your efforts and patience,

Luke

 

[AlphaFrog]

You're welcome. I'm glad it worked.

15-20 seconds still seems way slow. I would think it would take 2-3 seconds at most, but again I don't have the big picture. You may have other things going on I don't know about.

This may help to speed things up a little. Put this at the start of the code and replace the existing Application.ScreenUpdating line...

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

And put this at the end....

    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True