Forum Discussion

Copper Contributor

Dec 20, 2023

Solved

VBA HELP WITH AN ARRAY

Still learning and struggle with array's -- looking for help to shorten the below listed code. As is it works perfectly and does what I need it to, just takes too long. Hoping an array would make it ...

Macros and VBA

djclements

Dec 22, 2023

spazyp45 This appears to be the reverse procedure to your previous question: still learning- looking for help with excel vba

The following method loads the source data to an array, then outputs multiple values at once using a secondary array:

Private Sub LoadScheduleData()
    Dim wsSource As Worksheet, lastRow As Long, rowId As Long
    Set wsSource = Sheets("Sheet4")
    lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row

    For rowId = 3 To lastRow
        If wsSource.Cells(rowId, 1).Value = TextBox1.Value Then
            Dim wsOutput As Worksheet, data As Variant
            Set wsOutput = Sheets("Sheet2")
            data = wsSource.Cells(rowId, 1).Resize(, 500).Value

            With wsOutput
            ' output to individual cells (with no pattern)
                .Cells(15, 27).Value = data(1, 8)
                .Cells(3, 1).Value = data(1, 27)
                .Cells(3, 7).Value = data(1, 28)
                .Cells(3, 8).Value = data(1, 29)
                .Cells(4, 2).Value = data(1, 30)
                .Cells(4, 7).Value = data(1, 31)
                .Cells(6, 3).Value = data(1, 40)

            ' output data: row 5; col 5 to 12
                Dim arr() As Variant, j As Long, k As Long
                ReDim arr(1 To 1, 1 To 8)
                k = 31
                For j = 1 To 8
                    arr(1, j) = data(1, j + k)
                Next j
                .Cells(5, 5).Resize(, UBound(arr, 2)).Value = arr

            ' output data: row 7 to 52; col 1, 4 to 12
                Dim col() As Variant, i As Long
                ReDim col(1 To 46, 1 To 1)
                ReDim arr(1 To 46, 1 To 9)
                For i = 1 To 46
                    k = k + 10
                    col(i, 1) = data(1, k)
                    For j = 1 To 9
                        arr(i, j) = data(1, j + k)
                    Next j
                Next i
                .Cells(7, 1).Resize(UBound(col, 1)).Value = col
                .Cells(7, 4).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
            End With

        ' exit loop after loading data
            Exit For
        End If
    Next rowId
End Sub

NikolinoDE

Platinum Contributor

Dec 21, 2023

spazyp45

Try it with this code (it's untested).

Private Sub LoadScheduleData()
    Dim x As Long
    Dim y As Long
    Dim targetSheet As Worksheet
    Dim sourceSheet As Worksheet
    Dim targetRange As Range
    Dim sourceColumns As Variant
    Dim i As Long

    ' Set references to target and source sheets
    Set targetSheet = Sheets("Sheet2")
    Set sourceSheet = Sheets("Sheet4")

    ' Set the target range where data will be loaded
    Set targetRange = targetSheet.Range("A3:L52")

    ' Set the source columns array
    sourceColumns = Array(27, 8, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, _
                          41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, _
                          57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, _
                          73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, _
                          89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, _
                          104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, _
                          117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, _
                          130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, _
                          143, 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, _
                          156, 157, 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, _
                          169, 170)

    ' Find the last row in the source sheet
    x = sourceSheet.Range("A" & Rows.Count).End(xlUp).Row

    ' Loop through the rows in the source sheet
    For y = 3 To x
        ' Check if the current row matches the specified condition
        If sourceSheet.Cells(y, 1).Value = TextBox1.Text Then
            ' Loop through the columns and copy data to the target range
            For i = LBound(sourceColumns) To UBound(sourceColumns)
                targetRange.Cells(i + 1).Value = sourceSheet.Cells(y, sourceColumns(i)).Text
            Next i

            ' Exit the loop since the condition is met for this row
            Exit For
        End If
    Next y
End Sub

My answers are voluntary and without guarantee!

Hope this will help you.

Was the answer useful? Mark as best response and like it!

This will help all forum participants.

spazyp45

Copper Contributor

Dec 22, 2023

This works with some minor tweaks, however it runs just as sluggish as my obnoxiously lengthy code. anyone have any suggestions/thoughts on what I could/should do to speed it up? Both of these codes take about 3-4 minutes to run- hoping to get that down if possible- if not i understand.

NikolinoDE

Platinum Contributor

Dec 22, 2023

spazyp45

Here are a few suggestions to potentially improve the performance of your code:

Disable Screen Updating and Automatic Calculation: Add the following lines at the beginning of your code to temporarily disable screen updating and automatic calculation, which can significantly speed up the execution of your code.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

And add the following lines at the end of your code to revert the changes:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

This prevents Excel from updating the screen and recalculating formulas during the execution of your code.

Copy Entire Rows Instead of Cell by Cell: Instead of copying cell by cell, you can try copying entire rows at once. Replace the inner loop with the following code:

' Loop through the columns and copy data to the target range
targetRange.Rows(1).Value = sourceSheet.Rows(y).Cells(sourceColumns).Value

This should be faster because it avoids looping through each cell individually.

Here is how you can integrate these suggestions into your existing code:

Private Sub LoadScheduleData()
    Dim x As Long
    Dim y As Long
    Dim targetSheet As Worksheet
    Dim sourceSheet As Worksheet
    Dim targetRange As Range
    Dim sourceColumns As Variant

    ' Disable screen updating and automatic calculation
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Set references to target and source sheets
    Set targetSheet = Sheets("Sheet2")
    Set sourceSheet = Sheets("Sheet4")

    ' Set the target range where data will be loaded
    Set targetRange = targetSheet.Range("A3:L52")

    ' Set the source columns array
    sourceColumns = Array(27, 8, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, _
                          41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, _
                          57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, _
                          73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, _
                          89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, _
                          104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, _
                          117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, _
                          130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, _
                          143, 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, _
                          156, 157, 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, _
                          169, 170)

    ' Find the last row in the source sheet
    x = sourceSheet.Range("A" & Rows.Count).End(xlUp).Row

    ' Loop through the rows in the source sheet
    For y = 3 To x
        ' Check if the current row matches the specified condition
        If sourceSheet.Cells(y, 1).Value = TextBox1.Text Then
            ' Loop through the columns and copy data to the target range
            targetRange.Rows(1).Value = sourceSheet.Rows(y).Cells(sourceColumns).Value

            ' Exit the loop since the condition is met for this row
            Exit For
        End If
    Next y

    ' Re-enable screen updating and automatic calculation
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Try and see if it improves the performance, the suggestions are untested please make a backup before you make any step. If you are still facing slowness, there might be other factors involved.

The text, steps and codes were created with the help of AI.

My answers are voluntary and without guarantee!

Hope this will help you.

Was the answer useful? Mark as best response and Like it!

This will help all forum participants.

spazyp45
Copper Contributor
Dec 22, 2023
disabling screen updating made a small improvement - takes only about a minute now. the other code for entire row rather than cell by cell does not work. however, with disabling screen updating that seems to be sufficient for what i need- thank you!