Forum Discussion
still learning- looking for help with excel vba
- 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 SubIf you have any questions, please don't hesitate to ask. Cheers!
spazyp45 It appears as though the output data is the same for each iteration of the loop (the values being transferred from Sheet2 are coming from fixed locations). As such, you can speed things up by passing those values to an array first, then returning the entire array to each applicable row in the loop. However, before providing an example, there is one thing I noticed that needs to be clarified...
The output range for each row on Sheet4 includes every column from 27 to 141 with the exception of column 133. Is this by design? Or is it a mistake? Should the output range be from column 27 to 140 and include column 133? Or does it truly need to skip over column 133?
djclements -- nope 133 was an accidental omission. it should be included -- yes, actually all the values are fixed locations with the exception of determining what row to use on sheet 4 -- otherwise the data from sheet 2 is just copied over to sheet 4 beginning in column 27 and looping through until all data from sheet 2 has been copied
- djclementsDec 08, 2023Silver Contributor
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 SubIf you have any questions, please don't hesitate to ask. Cheers!
- spazyp45Dec 08, 2023Copper Contributorworks like a charm -- perfect thank you very much -- and thank you for including explanation as I can follow along perfectly with it and learned something new