Search code examples
excelvbacopy-paste

Copy/paste data + loop through rows

On Sheet 1, I have a date in Column A, coordinates in Column B (latitude) and in column C (longitude).

On Sheet 2, I have a calculation, based on coordinates, that returns the sunset time per date.

When there are coordinates, I want to copy both latitude and longitude to Sheet 2 cell B3.
Then, I want to Vlookup the date for which the coordinates were copied (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).

For one entry in the data set, should it look like the below example?

And how would I loop through the 34 rows of that table in Sheet 1?
It would need to do that when there is data, avoiding the empty cells.

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)

Sheet 1
Sheet 1

Sheet 2
Sheet 2

Result of your updated code
Result of your updated code

Solution

  • 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