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

 

[sharpdog]

I came across one more problem. The second two ranges of cells (B30:AT49, B54:AT73)
are being duplicated with the original range B6:AT25 of cells info. I know how to change the wbf, but I don't understand the code enough to change it. I started to modify it and changed the 'comments regarding the code to indicate what I need. Here is what I have.

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")
        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
        
        
        Set rng = .Range("B30:AT49")
        For Each cel In rng
            '=ADDRESS(MATCH(B$28,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
        
         Set rng = .Range("B54:AT73")
        For Each cel In rng
            '=ADDRESS(MATCH(B$52,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

Could you explain this part of the code to me?

 adr = Evaluate("ADDRESS(MATCH(" & Cells(4, cel.Column).Address & ",Dates,0)+4,MATCH(A" & cel.Row & ",Names,0)+2)")

'particularly the: ' & Cells'   and    '(A" & cel.Row &" ' part.

 

[sharpdog]

I also just added the code to turn off calculations while the macro is running, and it improved the run time by about 10 seconds. Thanks

 

[AlphaFrog]

Could you explain this part of the code to me?

 adr = Evaluate("ADDRESS(MATCH(" & Cells(4, cel.Column).Address & ",Dates,0)+4,MATCH(A" & cel.Row & ",Names,0)+2)")

'particularly the: ' & Cells'   and    '(A" & cel.Row &" ' part.

It creates a cell reference relative to the current cell the formula is being calculated for. So Cells(4, cel.Column).Address is the cell address of row 4 and the the column of the formula cell. If the formula cell is B6, that would create a reference to cell B4.

This should fix it.

Sub Copy_Lookups_wo_Borders()
    
    Dim rngArea As Range, cel As Range, rng As Range, i As Integer
    Dim adr As Variant, t As Single
    
    t = Timer
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    With Sheets("View Schedule")
        Set rng = .Range("B6:AT25, B30:AT49, B54:AT73")
        For Each rngArea In rng.Areas
            For Each cel In rngArea
                '=ADDRESS(MATCH(B$4,Dates,0)+4,MATCH($A6,Names,0)+2)
                adr = Evaluate("ADDRESS(MATCH(" & Cells(rngArea(1).Row - 2, 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
                
            Next cel
        Next rngArea
        ' Erase copied borders
        For i = 5 To 12
            rng.Borders(i).LineStyle = xlNone
        Next i
    End With
    
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    MsgBox "Copy complete" & vbCr & Format(Timer - t, "0.00 seconds")
    
End Sub

 

[sharpdog]

Genius!

Thankyou AlphaFrog,

Luke