Excel VBA - copy/paste data + loop throughout rows

Question

Let me start off by already thanking you guys for your help.

What i am trying to achieve with a very limited knowledge of VBA programming is this.

On the first sheet, I have a date in Column A, coordinates in column B (latitude) and in column C (longitude).

On sheet 2, I have a whole calculation, based on coordinates, that return the sunset time per date.

Basically, what I want to do is, when there are coordinates, I want to copy these (both latitude and longitude), go to sheet 2 and copy them in B3. Then, I want to Vlookup the date for which the coordinates were copied (located in Sheet 1, column A) to copy the corresponding sunset time and paste it in Sheet 1 in the column D (next to the longitude).

I first wanted to make it work for 1 of the entry in the data set. Should it look like the below example ?

And then, how would I loop this throughout the 34 rows of that table in Sheet 1? It would need to do that when there actually are datas, avoiding the empty cells.

Many thanks in advance for your help.

Kind regards,

Arnaud

    Dim iRow&
    Dim sRange$
    Dim timetable As Range
    Dim WS As Worksheet, WS2 As Worksheet
    
'set up worksheet variables
    Set WS = ThisWorkbook.Sheets("Sheet1")
    Set WS2 = ThisWorkbook.Sheets("Sheet2")
    
' defines the table returning the sunset time
    Set timetable = WS2.Range("D2:Z368")
    
    For iRow = 12 To 45
        If Not IsEmpty(WS.Cells(iRow, 45)) And Not IsEmpty(WS.Cells(iRow, 46)) Then
            WS.Range("AS" & iRow & ":AT" & iRow).Copy
            WS2.Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        End If
        
        sRange = "AU" & iRow
        'create formula for first cell
        WS.Range(sRange).Formula = "=IFERROR(IF(OR(AS" & iRow & "="""",AT" & iRow & "=""""),"""",VLOOKUP(AR" & iRow & ",Sheet2!D$2:Z$368,23,FALSE)),""Value missing from Sheet2 table"")"
        'remove formula
        WS.Range(sRange).Copy
        WS.Range(sRange).PasteSpecial (xlPasteValues)

user_1970243 · Answer

I have cleaned up your original macro generated code. I replaced the worksheet function with a formula inserted directly onto the sheet and then copied the formula to the other 33 cells as requested. This simplified the VBA needed. I tested it and it works.

the Excel IFERROR function displays a message if an error occurs, in this case a value missing from the table on Sheet2


    Option Explicit
    
    Private Sub Test()
    
    Dim iRow&
    Dim sRange$
    Dim timetable As Range
    Dim WS As Worksheet, WS2 As Worksheet
    
    'set up worksheet variables for cleaner, more easily readable code
    Set WS = ThisWorkbook.Sheets("Sheet1")
    Set WS2 = ThisWorkbook.Sheets("Sheet2")
    
    Set timetable = WS2.Range("D2:Z368")
    
    For iRow = 12 To 45
        If Not IsEmpty(WS.Cells(iRow, 45)) And Not IsEmpty(WS.Cells(iRow, 46)) Then
            WS.Range("AS" & iRow & ":AT" & iRow).Copy
            WS2.Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        End If
        
        'this is your modified original line of code
        'WS.Range("AU12") = Application.WorksheetFunction.VLookup(WS.Range("AR12"), timetable, 23, False)
        
        sRange = "AU" & iRow
        'create formula for first cell
        WS.Range(sRange).Formula = "=IFERROR(IF(OR(AS" & iRow & "="""",AT" & iRow & "=""""),"""",VLOOKUP(AR" & iRow & ",Sheet2!D$2:Z$368,23,FALSE)),""Value missing from Sheet2 table"")"
        'remove formula
        WS.Range(sRange).Copy
        WS.Range(sRange).PasteSpecial (xlPasteValues)
    Next
    
    'copy formula to the additional 33 cells as requested
    
    'WS.Range("AU12").Copy
    'WS.Range("AU12:AU45").PasteSpecial Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    End Sub

Excel VBA - copy/paste data + loop throughout rows

1 Answers