CODEWITHSUNDEEP
excelvba
silentninja89
silentninja89

Reputation: 201

VBA code for saving specific range of rows

Question regarding the code below. I need this randomizer to save the random entries that it created on a separated file without deleting previous entries that got saved, how should I proceed?

    Private Sub CommandButton1_Click()
    Dim lastRow As Long
    Dim shAudit As Worksheet
    Dim shData As Worksheet
    Dim r As Long
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    Dim key As Variant

    name = Range(A5, H9).Value


    Set shAudit = ThisWorkbook.Sheets("Sheet1")
    Set shData = ThisWorkbook.Sheets("Sheet2")
    lastRow = shData.Range("A" & shData.Rows.Count).End(xlUp).Row

    'Pick 5 random records with no repeats
        Do Until dict.Count = 5
        r = Application.WorksheetFunction.RandBetween(2, lastRow)
        If Sheets("Sheet1").Range("A2") = Sheets("Sheet2").Cells(r, "G") Then
          If Not dict.Exists(r) Then
              dict.Add r, r
          End If
        End If
    Loop

    r = 0
    For Each key In dict.Keys
        shData.Range("A1:H1").Offset(key - 1, 0).Copy shAudit.Range("A5:H5").Offset(r, 0)
        r = r + 1
    Next key

    End Sub

Upvotes: 1

Views: 169

Answers (1)

SJR
SJR

Reputation: 23081

You can add this line just before End Sub. Change the sheet name to suit.

Worksheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2).Resize(dict.Count) = Application.Transpose(dict.keys)

Upvotes: 1

Related Questions