SOLVED

still learning- looking for help with excel vba

Copper Contributor

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 on the selected row. currently i am going cell by cell however i will have to do this for over 1000 cells and am looking to speed things up a bit. if anyone can help with a loop to do this that would be appreciated- see below. happy to answer and questions. (*based on what i am trying to do, copying the cell data and pasting wont work*)

 

Sub SAVESCHEDULE()
Dim x As Long
Dim y As Long

x = Sheets("Sheet4").Range("A" & Rows.Count).End(xlUp).Row
For y = 4 To x
If Sheets("Sheet4").Cells(y, 1).Value = Sheet2.Cells(11, 27) Then

Sheets("Sheet4").Cells(y, 27).Value = Sheet2.Cells(3, 1).Text
Sheets("Sheet4").Cells(y, 28).Value = Sheet2.Cells(3, 7).Text
Sheets("Sheet4").Cells(y, 29).Value = Sheet2.Cells(3, 8).Text
Sheets("Sheet4").Cells(y, 30).Value = Sheet2.Cells(4, 2).Text
Sheets("Sheet4").Cells(y, 31).Value = Sheet2.Cells(4, 7).Text
Sheets("Sheet4").Cells(y, 32).Value = Sheet2.Cells(5, 5).Text
Sheets("Sheet4").Cells(y, 33).Value = Sheet2.Cells(5, 6).Text
Sheets("Sheet4").Cells(y, 34).Value = Sheet2.Cells(5, 7).Text
Sheets("Sheet4").Cells(y, 35).Value = Sheet2.Cells(5, 8).Text
Sheets("Sheet4").Cells(y, 36).Value = Sheet2.Cells(5, 9).Text
Sheets("Sheet4").Cells(y, 37).Value = Sheet2.Cells(5, 10).Text
Sheets("Sheet4").Cells(y, 38).Value = Sheet2.Cells(5, 11).Text
Sheets("Sheet4").Cells(y, 39).Value = Sheet2.Cells(5, 12).Text
Sheets("Sheet4").Cells(y, 40).Value = Sheet2.Cells(6, 3).Text
Sheets("Sheet4").Cells(y, 41).Value = Sheet2.Cells(7, 1).Text
Sheets("Sheet4").Cells(y, 42).Value = Sheet2.Cells(7, 4).Text
Sheets("Sheet4").Cells(y, 43).Value = Sheet2.Cells(7, 5).Text
Sheets("Sheet4").Cells(y, 44).Value = Sheet2.Cells(7, 6).Text
Sheets("Sheet4").Cells(y, 45).Value = Sheet2.Cells(7, 7).Text
Sheets("Sheet4").Cells(y, 46).Value = Sheet2.Cells(7, 8).Text
Sheets("Sheet4").Cells(y, 47).Value = Sheet2.Cells(7, 9).Text
Sheets("Sheet4").Cells(y, 48).Value = Sheet2.Cells(7, 10).Text
Sheets("Sheet4").Cells(y, 49).Value = Sheet2.Cells(7, 11).Text
Sheets("Sheet4").Cells(y, 50).Value = Sheet2.Cells(7, 12).Text
Sheets("Sheet4").Cells(y, 51).Value = Sheet2.Cells(8, 1).Text
Sheets("Sheet4").Cells(y, 52).Value = Sheet2.Cells(8, 4).Text
Sheets("Sheet4").Cells(y, 53).Value = Sheet2.Cells(8, 5).Text
Sheets("Sheet4").Cells(y, 54).Value = Sheet2.Cells(8, 6).Text
Sheets("Sheet4").Cells(y, 55).Value = Sheet2.Cells(8, 7).Text
Sheets("Sheet4").Cells(y, 56).Value = Sheet2.Cells(8, 8).Text
Sheets("Sheet4").Cells(y, 57).Value = Sheet2.Cells(8, 9).Text
Sheets("Sheet4").Cells(y, 58).Value = Sheet2.Cells(8, 10).Text
Sheets("Sheet4").Cells(y, 59).Value = Sheet2.Cells(8, 11).Text
Sheets("Sheet4").Cells(y, 60).Value = Sheet2.Cells(8, 12).Text
Sheets("Sheet4").Cells(y, 61).Value = Sheet2.Cells(9, 1).Text
Sheets("Sheet4").Cells(y, 62).Value = Sheet2.Cells(9, 4).Text
Sheets("Sheet4").Cells(y, 63).Value = Sheet2.Cells(9, 5).Text
Sheets("Sheet4").Cells(y, 64).Value = Sheet2.Cells(9, 6).Text
Sheets("Sheet4").Cells(y, 65).Value = Sheet2.Cells(9, 7).Text
Sheets("Sheet4").Cells(y, 66).Value = Sheet2.Cells(9, 8).Text
Sheets("Sheet4").Cells(y, 67).Value = Sheet2.Cells(9, 9).Text
Sheets("Sheet4").Cells(y, 68).Value = Sheet2.Cells(9, 10).Text
Sheets("Sheet4").Cells(y, 69).Value = Sheet2.Cells(9, 11).Text
Sheets("Sheet4").Cells(y, 70).Value = Sheet2.Cells(9, 12).Text
Sheets("Sheet4").Cells(y, 71).Value = Sheet2.Cells(10, 1).Text
Sheets("Sheet4").Cells(y, 72).Value = Sheet2.Cells(10, 4).Text
Sheets("Sheet4").Cells(y, 73).Value = Sheet2.Cells(10, 5).Text
Sheets("Sheet4").Cells(y, 74).Value = Sheet2.Cells(10, 6).Text
Sheets("Sheet4").Cells(y, 75).Value = Sheet2.Cells(10, 7).Text
Sheets("Sheet4").Cells(y, 76).Value = Sheet2.Cells(10, 8).Text
Sheets("Sheet4").Cells(y, 77).Value = Sheet2.Cells(10, 9).Text
Sheets("Sheet4").Cells(y, 78).Value = Sheet2.Cells(10, 10).Text
Sheets("Sheet4").Cells(y, 79).Value = Sheet2.Cells(10, 11).Text
Sheets("Sheet4").Cells(y, 80).Value = Sheet2.Cells(10, 12).Text
Sheets("Sheet4").Cells(y, 81).Value = Sheet2.Cells(11, 1).Text
Sheets("Sheet4").Cells(y, 82).Value = Sheet2.Cells(11, 4).Text
Sheets("Sheet4").Cells(y, 83).Value = Sheet2.Cells(11, 5).Text
Sheets("Sheet4").Cells(y, 84).Value = Sheet2.Cells(11, 6).Text
Sheets("Sheet4").Cells(y, 85).Value = Sheet2.Cells(11, 7).Text
Sheets("Sheet4").Cells(y, 86).Value = Sheet2.Cells(11, 8).Text
Sheets("Sheet4").Cells(y, 87).Value = Sheet2.Cells(11, 9).Text
Sheets("Sheet4").Cells(y, 88).Value = Sheet2.Cells(11, 10).Text
Sheets("Sheet4").Cells(y, 89).Value = Sheet2.Cells(11, 11).Text
Sheets("Sheet4").Cells(y, 90).Value = Sheet2.Cells(11, 12).Text
Sheets("Sheet4").Cells(y, 91).Value = Sheet2.Cells(12, 1).Text
Sheets("Sheet4").Cells(y, 92).Value = Sheet2.Cells(12, 4).Text
Sheets("Sheet4").Cells(y, 93).Value = Sheet2.Cells(12, 5).Text
Sheets("Sheet4").Cells(y, 94).Value = Sheet2.Cells(12, 6).Text
Sheets("Sheet4").Cells(y, 95).Value = Sheet2.Cells(12, 7).Text
Sheets("Sheet4").Cells(y, 96).Value = Sheet2.Cells(12, 8).Text
Sheets("Sheet4").Cells(y, 97).Value = Sheet2.Cells(12, 9).Text
Sheets("Sheet4").Cells(y, 98).Value = Sheet2.Cells(12, 10).Text
Sheets("Sheet4").Cells(y, 99).Value = Sheet2.Cells(12, 11).Text
Sheets("Sheet4").Cells(y, 100).Value = Sheet2.Cells(12, 12).Text
Sheets("Sheet4").Cells(y, 101).Value = Sheet2.Cells(13, 1).Text
Sheets("Sheet4").Cells(y, 102).Value = Sheet2.Cells(13, 4).Text
Sheets("Sheet4").Cells(y, 103).Value = Sheet2.Cells(13, 5).Text
Sheets("Sheet4").Cells(y, 104).Value = Sheet2.Cells(13, 6).Text
Sheets("Sheet4").Cells(y, 105).Value = Sheet2.Cells(13, 7).Text
Sheets("Sheet4").Cells(y, 106).Value = Sheet2.Cells(13, 8).Text
Sheets("Sheet4").Cells(y, 107).Value = Sheet2.Cells(13, 9).Text
Sheets("Sheet4").Cells(y, 108).Value = Sheet2.Cells(13, 10).Text
Sheets("Sheet4").Cells(y, 109).Value = Sheet2.Cells(13, 11).Text
Sheets("Sheet4").Cells(y, 110).Value = Sheet2.Cells(13, 12).Text
Sheets("Sheet4").Cells(y, 111).Value = Sheet2.Cells(14, 1).Text
Sheets("Sheet4").Cells(y, 112).Value = Sheet2.Cells(14, 4).Text
Sheets("Sheet4").Cells(y, 113).Value = Sheet2.Cells(14, 5).Text
Sheets("Sheet4").Cells(y, 114).Value = Sheet2.Cells(14, 6).Text
Sheets("Sheet4").Cells(y, 115).Value = Sheet2.Cells(14, 7).Text
Sheets("Sheet4").Cells(y, 116).Value = Sheet2.Cells(14, 8).Text
Sheets("Sheet4").Cells(y, 117).Value = Sheet2.Cells(14, 9).Text
Sheets("Sheet4").Cells(y, 118).Value = Sheet2.Cells(14, 10).Text
Sheets("Sheet4").Cells(y, 119).Value = Sheet2.Cells(14, 11).Text
Sheets("Sheet4").Cells(y, 120).Value = Sheet2.Cells(14, 12).Text
Sheets("Sheet4").Cells(y, 121).Value = Sheet2.Cells(15, 1).Text
Sheets("Sheet4").Cells(y, 122).Value = Sheet2.Cells(15, 4).Text
Sheets("Sheet4").Cells(y, 123).Value = Sheet2.Cells(15, 5).Text
Sheets("Sheet4").Cells(y, 124).Value = Sheet2.Cells(15, 6).Text
Sheets("Sheet4").Cells(y, 125).Value = Sheet2.Cells(15, 7).Text
Sheets("Sheet4").Cells(y, 126).Value = Sheet2.Cells(15, 8).Text
Sheets("Sheet4").Cells(y, 127).Value = Sheet2.Cells(15, 9).Text
Sheets("Sheet4").Cells(y, 128).Value = Sheet2.Cells(15, 10).Text
Sheets("Sheet4").Cells(y, 129).Value = Sheet2.Cells(15, 11).Text
Sheets("Sheet4").Cells(y, 130).Value = Sheet2.Cells(15, 12).Text
Sheets("Sheet4").Cells(y, 131).Value = Sheet2.Cells(16, 1).Text
Sheets("Sheet4").Cells(y, 132).Value = Sheet2.Cells(16, 4).Text
Sheets("Sheet4").Cells(y, 134).Value = Sheet2.Cells(16, 5).Text
Sheets("Sheet4").Cells(y, 135).Value = Sheet2.Cells(16, 6).Text
Sheets("Sheet4").Cells(y, 136).Value = Sheet2.Cells(16, 7).Text
Sheets("Sheet4").Cells(y, 137).Value = Sheet2.Cells(16, 8).Text
Sheets("Sheet4").Cells(y, 138).Value = Sheet2.Cells(16, 9).Text
Sheets("Sheet4").Cells(y, 139).Value = Sheet2.Cells(16, 10).Text
Sheets("Sheet4").Cells(y, 140).Value = Sheet2.Cells(16, 11).Text
Sheets("Sheet4").Cells(y, 141).Value = Sheet2.Cells(16, 12).Text

End If
Next y

5 Replies

@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.

@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 

best response confirmed by spazyp45 (Copper Contributor)
Solution

@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!

works 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
1 best response

Accepted Solutions
best response confirmed by spazyp45 (Copper Contributor)
Solution

@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!

View solution in original post