VBA assistance

sekiro89

New member
Joined
Oct 2, 2018
Messages
1
Reaction score
0
Points
0
Excel Version(s)
2017
Hello guys, code below is a randomizer for previous week, however I need to save the information to a file and that when it's saved that it won't overwrite previous versions of it just to keep coping to the last used row that it was in there, could you please assist?

And also if it's possible to look into the file that was saved and to look up for repeated values and don't save it again or change the row?

Test file attached.

Code:
Private Sub CommandButton1_Click()
Dim lr As Long, wks As Worksheet
Dim filename4 As String, strFilename4 As String
strFilename = "\Audits " & Format(Now(), "ddmmyy hhmmss")
Filename = ActiveWorkbook.Path & strFilename & ".xlsm"
Application.ScreenUpdating = False
Set wks = ActiveSheet
Sheets("Sheet2").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
  lr = .Cells(.Rows.Count, "A").End(xlUp).Row
  .Range("A1:H" & lr).Sort key1:=.Range("G1"), Header:=xlYes
  .Range("A1:H" & lr).AutoFilter Field:=7, Criteria1:="<>" & Sheets("Sheet1").Range("A2").Value
  .Rows("1:" & lr).Delete Shift:=xlUp
  lr = .Cells(.Rows.Count, "A").End(xlUp).Row
  If lr > 5 Then
    .Range("I1:I" & lr).FormulaR1C1 = "=RAND()+(RC1>today()-7)"
    .Calculate
    .Range("I1:I" & lr).Value = .Range("I1:I" & lr).Value
    .Range("A1:I" & lr).Sort key1:=.Range("I1"), order1:=xlDescending, Header:=xlNo
    wks.Range("A5:H9").Value = .Range("A1:H5").Value
  Else
    MsgBox "Please enter a valid login to proceed"
  End If
  Application.DisplayAlerts = False
  .Delete
  Application.DisplayAlerts = True
End With
wks.Activate
Set wks = Nothing
Application.ScreenUpdating = True

Sheet1.SaveAs Filename:=Filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
MsgBox "File was saved to your desktop as " & strFilename

End Sub
 

Attachments

  • testing.xlsm
    26.3 KB · Views: 14
Back
Top