excelvbaxlookup

Improving a VBA Switch to auto-update as new data arrives

I have a VBA Switch that switches between two sets of data, it is written as follows:

Private Sub ToggleButton1_Click()
    Application.ScreenUpdating = False

If ToggleButton1.Value = False Then
    ToggleButton1.Caption = "Switch to 2"
    Worksheets("Sheet3").Range("G3") = "Label1-1"
    Worksheets("Sheet3").Range("Z3") = "Label1-2"
    Worksheets("Sheet3").Range("AS3") = "Label1-3"
    Worksheets("Sheet3").Range("BL3") = "Label1-4"
    Worksheets("Sheet2").Range("E3:Q737").Copy Range("G6")
    Worksheets("Sheet2").Range("R3:AD737").Copy Range("Z6")
    Range("BL6:BL740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$A6:$A624"), Worksheets("Sheet4").Range("F$6:F$624"), "", 0, 1)
    Range("BM6:BM740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$A6:$A624"), Worksheets("Sheet4").Range("G$6:G$624"), "", 0, 1)
    Range("BN6:BN740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$A6:$A624"), Worksheets("Sheet4").Range("H$6:H$624"), "", 0, 1)
    Range("BO6:BO740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$A6:$A624"), Worksheets("Sheet4").Range("I$6:I$624"), "", 0, 1)
    Range("BP6:BP740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$A6:$A624"), Worksheets("Sheet4").Range("J$6:J$624"), "", 0, 1)
    Range("BQ6:BQ740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$A6:$A624"), Worksheets("Sheet4").Range("K$6:K$624"), "", 0, 1)
    Range("BR6:BR740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$A6:$A624"), Worksheets("Sheet4").Range("L$6:L$624"), "", 0, 1)
    Range("BS6:BS740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$A6:$A624"), Worksheets("Sheet4").Range("M$6:M$624"), "", 0, 1)
    Range("BT6:BT740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$A6:$A624"), Worksheets("Sheet4").Range("N$6:N$624"), "", 0, 1)
    Range("BU6:BU740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$A6:$A624"), Worksheets("Sheet4").Range("O$6:O$624"), "", 0, 1)
    Range("BV6:BV740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$A6:$A624"), Worksheets("Sheet4").Range("P$6:P$624"), "", 0, 1)
    Range("BW6:BW740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$A6:$A624"), Worksheets("Sheet4").Range("Q$6:Q$624"), "", 0, 1)
    Range("BX6:BX740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$A6:$A624"), Worksheets("Sheet4").Range("R$6:R$624"), "", 0, 1)
    
    
Else: ToggleButton1.Value = True
    ToggleButton1.Caption = "Switch to 1"
    Worksheets("Sheet3").Range("G3") = "Label2-1"
    Worksheets("Sheet3").Range("Z3") = "Label2-2"
    Worksheets("Sheet3").Range("AS3") = "Label2-3"
    Worksheets("Sheet3").Range("BL3") = "Label2-4"
    Worksheets("Actuals 2022-2023").Range("AJ3:AV737").Copy Range("G6")
    Worksheets("Actuals 2022-2023").Range("AW3:BI737").Copy Range("Z6")
    Range("BL6:BL740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$U6:$U740"), Worksheets("Sheet4").Range("$Z$6:$Z$740"), "", 0, 1)
    Range("BM6:BM740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$U6:$U740"), Worksheets("Sheet4").Range("$AA$6:$AA$740"), "", 0, 1)
    Range("BN6:BN740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$U6:$U740"), Worksheets("Sheet4").Range("$AB$6:$AB$740"), "", 0, 1)
    Range("BO6:BO740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$U6:$U740"), Worksheets("Sheet4").Range("$AC$6:$AC$740"), "", 0, 1)
    Range("BP6:BP740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$U6:$U740"), Worksheets("Sheet4").Range("$AD$6:$AD$740"), "", 0, 1)
    Range("BQ6:BQ740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$U6:$U740"), Worksheets("Sheet4").Range("$AE$6:$AE$740"), "", 0, 1)
    Range("BR6:BR740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$U6:$U740"), Worksheets("Sheet4").Range("$AF$6:$AF$740"), "", 0, 1)
    Range("BS6:BS740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$U6:$U740"), Worksheets("Sheet4").Range("$AD$6:$AD$740"), "", 0, 1)
    Range("BT6:BT740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$U6:$U740"), Worksheets("Sheet4").Range("$AH$6:$AH$740"), "", 0, 1)
    Range("BU6:BU740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$U6:$U740"), Worksheets("Sheet4").Range("$AI$6:$AI$740"), "", 0, 1)
    Range("BV6:BV740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$U6:$U740"), Worksheets("Sheet4").Range("$AJ$6:$AJ$740"), "", 0, 1)
    Range("BW6:BW740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$U6:$U740"), Worksheets("Sheet4").Range("$AK$6:$AK$740"), "", 0, 1)
    Range("BX6:BX740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), Worksheets("Sheet4").Range("$U6:$U740"), Worksheets("Sheet4").Range("$AL$6:$AL$740"), "", 0, 1)



End If

    Application.ScreenUpdating = True
End Sub

Obviously this is bulky and as soon as the referenced data updates, it is likely to fail. Would there be a way to condense this? Particularly the XLOOKUPs would be great to get into one line, and then are modified to pic up when new rows are added. The columns should stay the same as they reference periods in a year, but I'd like to get it so that when new rows arrive, it includes them.

Any thoughts?

I have tried to create something along the lines of:

Range("BL6:BX740").Value = WorksheetFunction.XLookup(Worksheets("Sheet3").Range("$A6:$A740"), _
          Worksheets("Sheet4").Range("$U6:$U740"), _
          Worksheets("Sheet4").Range("$Z$6:$AK$740"), "", 0, 1)
Solution

  • I can't test, but something like this would be repetitive:

    Private Sub ToggleButton1_Click()
    
    Dim wb As Workbook, ws3 As Worksheet, ws4 As Worksheet, rng As Range, bOn As Boolean
    Dim col As Range, rngSrc As Range, rng2 As Range
    
    Set wb = ThisWorkbook
    Set ws3 = wb.Worksheets("Sheet3")
    Set ws4 = wb.Worksheets("Sheet4")
    Set rng = ws3.Range("$A6:$A740")
    
    Application.ScreenUpdating = False
    
    bOn = ToggleButton1.Value
    ToggleButton1.Caption = IIf(bOn, "Switch to 1", "Switch to 2")
    ws3.Range("G3") = IIf(bOn, "Label2-1", "Label1-1")
    ws3.Range("Z3") = IIf(bOn, "Label2-2", "Label1-2")
    ws3.Range("AS3") = IIf(bOn, "Label2-3", "Label1-3")
    ws3.Range("BL3") = IIf(bOn, "Label2-4", "Label1-4")
    
    If ToggleButton1.Value = False Then
        Worksheets("Sheet2").Range("E3:Q737").Copy Range("G6")
        Worksheets("Sheet2").Range("R3:AD737").Copy Range("Z6")
        Set rngSrc = ws4.Range("F$6:F$624")
        Set rng2 = ws4.Range("$A6:$A624")
     Else
        Worksheets("Actuals 2022-2023").Range("AJ3:AV737").Copy Range("G6")
        Worksheets("Actuals 2022-2023").Range("AW3:BI737").Copy Range("Z6")
        Set rngSrc = ws4.Range("$Z$6:$Z$740")
        Set rng2 = ws4.Range("$U6:$U740")
    End If
    
    'loop over and fill destination range columns
    For Each col In Me.Range("BL6:BX740").Columns
        col.Value = WorksheetFunction.XLookup(rng, rng2, rngSrc, "", 0, 1)
        Set rngSrc = rngSrc.Offset(0, 1) 'next source column over
    Next col

    Application.ScreenUpdating = True
End Sub