Forum Discussion

Copper Contributor

Dec 06, 2023

Solved

still learning- looking for help with excel vba

hello was looking for some help with a bit of VBA coding in excel. Still learning and i struggle with loops. i have a code that takes specific values from sheet2 and copies the text to sheet 4 based ...

Macros and VBA

djclements

Dec 08, 2023

spazyp45 Perfect. Here's what I would recommend to speed things up, since the data is coming from fixed locations on Sheet2. Rather than looping through every cell on Sheet2 for every output row on Sheet4, load the values into an array first (1 row x 114 columns), then output the entire array at once:

Option Explicit

Sub SaveSchedule()

'Load the source data into an array
    Dim wsSource As Worksheet, arr() As Variant
    Set wsSource = Sheets("Sheet2")
    ReDim arr(1 To 1, 1 To 114)

    With wsSource
    ' load individual cells (with no pattern)
        arr(1, 1) = .Cells(3, 1).Value
        arr(1, 2) = .Cells(3, 7).Value
        arr(1, 3) = .Cells(3, 8).Value
        arr(1, 4) = .Cells(4, 2).Value
        arr(1, 5) = .Cells(4, 7).Value
        arr(1, 14) = .Cells(6, 3).Value

    ' loop thru cells: row 5; col 5 to 12
        Dim j As Long
        For j = 5 To 12
            arr(1, j + 1) = .Cells(5, j).Value
        Next j

    ' loop thru cells: row 7 to 16; col 1, 4 to 12
        Dim i As Long, k As Long
        k = 2
        For i = 7 To 16
            k = k + 10
            arr(1, k + 3) = .Cells(i, 1).Value
            For j = 4 To 12
                arr(1, k + j) = .Cells(i, j).Value
            Next j
        Next i
    End With

'Output the array to each applicable row
    Dim wsOutput As Worksheet, LastRow As Long
    Set wsOutput = Sheets("Sheet4")
    LastRow = wsOutput.Cells(wsOutput.Rows.Count, 1).End(xlUp).Row
    k = UBound(arr, 2)

    For i = 4 To LastRow
        If wsOutput.Cells(i, 1).Value = wsSource.Cells(11, 27).Value Then
            wsOutput.Cells(i, 27).Resize(1, k).Value = arr
        End If
    Next i

End Sub

If you have any questions, please don't hesitate to ask. Cheers!

NikolinoDE

Platinum Contributor

Dec 06, 2023

spazyp45

You can use nested loops to iterate through the cells in Sheet2 and copy the values to the corresponding cells in Sheet4. Here's an example of how you might structure the loop to achieve this:

vba code (is untested):

Sub SAVESCHEDULE()
    Dim x As Long
    Dim y As Long
    Dim targetRow As Long
    Dim sourceColumn As Long
    Dim destColumn As Long
    
    ' Determine the last row with data in Sheet4
    x = Sheets("Sheet4").Cells(Rows.Count, "A").End(xlUp).Row
    
    ' Loop through rows in Sheet4
    For y = 4 To x
        ' Determine the target row in Sheet2 based on the value in Sheet4, column 1
        targetRow = WorksheetFunction.Match(Sheets("Sheet4").Cells(y, 1).Value, Sheets("Sheet2").Columns(27), 0)
        
        ' Check if a match is found in Sheet2
        If Not IsError(targetRow) Then
            ' Loop through columns in Sheet2 and copy values to Sheet4
            For sourceColumn = 1 To 16 ' Adjust the range as needed
                destColumn = sourceColumn + 26 ' Offset to start from column 27 in Sheet4
                Sheets("Sheet4").Cells(y, destColumn).Value = Sheet2.Cells(targetRow, sourceColumn).Text
            Next sourceColumn
        End If
    Next y
End Sub

This code uses the Match function to find the corresponding row in Sheet2 based on the value in column 1 of Sheet4. If a match is found, it loops through the columns (adjust the range as needed) and copies the values from Sheet2 to Sheet4.

Note: This assumes that the values to be copied are in the first 16 columns of each row in Sheet2 and that you want to start copying to column 27 in Sheet4. Adjust the column ranges based on your actual data layout. AI was partially deployed to support the text.

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.