Loop through a large range/array to manipulate data

I have a data range in Excel sheet_1 A10:H50000.

I need to find in column C a match of the text "40GP", if a match is found, the current row needs to be duplicated with an updated text value "40HC" in column C for the new row.
Eventually I need the updated array, including the new rows of "40HC", be written back to the sheet and overwrite the data range (A10:H50000).

Using the for loop method, code execution takes so long to complete. I attempted to use an array.

My VBA code using array after consulting ChatGPT 3.5. With this, there are many blank rows in the updated array.

My goal is to create a duplicate line for the current row that has "40GP" in column C and change the "40GP" with "40HC" for the new row and write the updated array back to the sheet in the same location, in a faster way than looping through the range.

Sub UpdateDataQuick()

    Dim ws As Worksheet
    Dim data As Variant
    Dim lastRow As Long
    Dim i As Long
    Dim newData As Variant
    Dim newRowCount As Long

    ' Assuming your data is in the active sheet. You can modify this accordingly.
    Set ws = ActiveSheet

    ' Find the last row in column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Read data into an array for faster processing
    data = ws.Range("A10:H" & lastRow).Value

    ' Loop through the array
    For i = LBound(data, 1) To UBound(data, 1)
        If data(i, 3) = "40GP" Then
            ' Duplicate the current row
            newRowCount = newRowCount + 1
        End If
    Next i

    ' Resize the new data array
    ReDim newData(1 To UBound(data, 1) + newRowCount, 1 To UBound(data, 2))

    ' Populate the new data array
    newRowCount = 0
    For i = LBound(data, 1) To UBound(data, 1)
        If data(i, 3) = "40GP" Then
            newRowCount = newRowCount + 1
            ' Duplicate the current row
            For j = 1 To UBound(data, 2)
                newData(i + newRowCount, j) = data(i, j)
            Next j
            ' Update the value in column C to "40HC"
            newData(i + newRowCount, 3) = "40HC"
        Else
            ' Copy the current row to the new array
            For j = 1 To UBound(data, 2)
            newData(i + newRowCount, j) = data(i, j)
            Next j
        End If
    Next i

    ' Write the updated data back to the worksheet
    ws.Range("A10").Resize(UBound(newData, 1), UBound(newData, 2)).Value = newData

    Application.CutCopyMode = False

End Sub

Solution

EDIT: updated to show full code, pushed array row copy into separate sub.

Like this maybe:

Sub UpdateDataQuick()
    
    Const FLAG_COL As Long = 3
    Const FLAG As String = "40GP"
    Dim ws As Worksheet, data As Variant, newData As Variant, rngData As Range
    Dim i As Long, rwOut As Long, addRows As Long

    Set ws = ActiveSheet
    Set rngData = ws.Range("A10:H" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    data = rngData.Value
    addRows = Application.CountIf(rngData.Columns(FLAG_COL), FLAG)
    
    ReDim newData(1 To UBound(data, 1) + addRows, 1 To UBound(data, 2))
    
    rwOut = 0 'row index for output array
    For i = LBound(data, 1) To UBound(data, 1)
        CopyRow data, i, newData, rwOut
        If data(i, 3) = "40GP" Then
            CopyRow data, i, newData, rwOut
            newData(rwOut, FLAG_COL) = "40HC"
        End If
    Next i
    'put output array on sheet (non-overlapping for testing)
    ws.Range("J10").Resize(UBound(newData, 1), UBound(newData, 2)).Value = newData

End Sub

'Copy data from 2-D array `arrSrc` at row index `rwSrc` to array `arrDest`
'  Increment destination array row index `rwOut` by 1 before the copy
'Assumed both arrays have the same # of columns
Sub CopyRow(arrSrc, rwSrc As Long, arrDest, ByRef rwOut As Long)
    Dim i As Long
    rwOut = rwOut + 1 ' increment output row index
    For i = LBound(arrSrc, 2) To UBound(arrSrc, 2)
        arrDest(rwOut, i) = arrSrc(rwSrc, i)
    Next i
End Sub