Retain source formatting when copying array (vba)

[patbuk]

Hello,

I utilized an excellent piece of code from JEC to sum duplicate rows based on certain columns and sum the 4 value columns, then delete the duplicates. I got that working - thank you - but here's my issue:

This is the first time I have ever worked with arrays (I'm guessing that's what I've got here) and I figured out that the code is creating the new range/array in memory and then needs to be "put" somewhere. The original code has it going below the sample in the same worksheet.

My data is tens of thousands of rows long. My first thought was to put the cleaned data over the source data - that works - but I have "leftover" rows of data since the cleaned data may be a hundred or more rows shorter.

So I decided to put it on a new sheet - that worked great and I was a happy camper but then I noticed the "Part Number" column lost its TEXT formatting with preceding zeros. I need those.

Is there a way to modify this line of code to retain the source formatting?
Sheets(2).Cells(1, 1).Resize(.Count, UBound(myRng, 2)) = Application.Index(.Items, 0, 0)

Or my second thought would be if I copied over the source data, how would I be able to determine the last row of the "cleaned" range and delete all the rows below it?
And then again, I'm open to anything that will accomplish my goal. I'm not worried about retaining cell colors, just the text formatting.
I have a small sample table, I downloaded the xl2bb add-in, I was able to copy it to the clipboard, but when I click the "Upload Mini Sheet" below nothing happens - I just get the message to download the add-in.

Here's the full piece of code:

Sub DuplicatesIn_COLsABC_SumColumnsDEFG()
Dim myRng, k, a, i As Long

 myRng = Sheets(1).Cells(1, 1).CurrentRegion
 
 With CreateObject("scripting.dictionary")
   For i = 1 To UBound(myRng)

    'k consists of Cols A, B, & C which create uniqueness
    'that combination is creating duplicates with different values in Cols D thru G

      k = myRng(i, 1) & myRng(i, 2) & myRng(i, 3)
      If Not .Exists(k) Then

    'spreadsheet has 7 columns, linked on A+B+C then Columns D-E-F-G are summed
         .Item(k) = Array(myRng(i, 1), myRng(i, 2), myRng(i, 3), myRng(i, 4), myRng(i, 5), myRng(i, 6), myRng(i, 7))
      Else
            a = .Item(k)
            a(3) = a(3) + myRng(i, 4)
            a(4) = a(4) + myRng(i, 5)
            a(5) = a(5) + myRng(i, 6)
            a(6) = a(6) + myRng(i, 7)
           .Item(k) = a
      End If
   Next
'The above works perfectly (after much trial and error on my part..)
        
'Paste merged data range into new sheet
'This is where I am unable to retain formatting from the source sheet (i.e. Part numbers have preceding zeros which I am losing when saving the modified range)
'I tried pasting over the existing data on Sheet1 but then I have excess rows at the bottom as the new range is shorter than source range

    Sheets(2).Cells(1, 1).Resize(.Count, UBound(myRng, 2)) = Application.Index(.Items, 0, 0)
 
End With
 
 MsgBox "Done."
 
End Sub

Thank you!

 

[patbuk]

I solved my immediate problem by copying the columns on the first sheet and doing a copy and then "PasteSpecial formats" options on the results sheet. Not a perfect solution but it's working for what I need. I do have another macro that cleans excess cells which I got by copying the column formatting that I am utilizing after.

Columns("A:G").Copy
    Sheets("Sheet2").Select
    Columns("A:G").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Cells.Select
    Application.CutCopyMode = False