0

I am new at writing VBA scripts and made the following to filer out some data, copy it to a new workbook and save this one in a specific folder....I am sure there are some beginner mistakes in this code...any suggestions to improve?

Private Sub CommandButton1_Click()
  Set NewBook = Workbooks.Add
  Dim strCriteria As String

  strCriteria = InputBox("Enter MyCollis Username or Leave Empty")

  If strCriteria = vbNullString Then
      Sheet1.[A1:F15000].Copy
  Else
      Sheet1.[A1:F15000].AutoFilter Field:=6, Criteria1:=strCriteria
      Sheet1.[A1:F15000].Copy
  End If

  NewBook.Worksheets("Sheet1").Range("B1").PasteSpecial (xlPasteValues)
  Selection.NumberFormat = "m/d/yyyy"

  ActiveWorkbook.SaveAs Filename:="C:\Users\36976\Desktop\" & "contracts" & "_" & strCriteria & "_" & Str(Format(Now(), "yyyymmdd")) & ".xlsx"

End Sub
Community
  • 1
  • 1
Wilco
  • 1
  • Looks good. Make sure you use code indentation and avoid `Select` statements unless you really need them – Tom Nov 23 '15 at 11:22
  • A few changes I'd make: Put `Option Exlpicit` at the top of your module to force you to declare your variables. Declare the `NewBook` variable as a `Workbook`. Give your button a name. Remembering what does what when you've got 50 buttons named CommandButton1 to CommandButton50 can be a bit hard. Maybe use some code to find the end of your data - will 15000 rows always be enough? As Tom said - avoid `Select` statements. Use `NewBook.SaveAs` rather than `ActiveWorkbook.SaveAs`. Maybe some code to check *MyCollis* is entered - you could enter anything and it will accept it as *MyCollis*. – Darren Bartrup-Cook Nov 23 '15 at 12:05

3 Answers3

2

Rather than hardcode the user login in the filesave, you could use

UserId = Environ("Username")
path = "C:\Users\" & UserId & "\Desktop\"
ActiveWorkbook.SaveAs Filename:=path & "contracts" & "_" & strCriteria & "_" & Format(Now(), "yyyymmdd") & ".xlsx"
Bob Phillips
  • 437
  • 1
  • 3
  • 7
  • Good point - the user input could be entered as `<>:"/\|?*.xlsx` and the code will accept it and then fail when saving the file. http://stackoverflow.com/questions/1976007/what-characters-are-forbidden-in-windows-and-linux-directory-names – Darren Bartrup-Cook Nov 23 '15 at 12:10
0

Thanks! both tips are usefull!

I now indeed ran into the issue that it copies over a lot of empty cells which is messing up my new sheet. How can I change the code to only copy the columns that contain text?

I found something like below, but not really sure how to implement it in my code.

 Lr = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  Lc = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

Thanks again!

Wilco
  • 1
0

Ok, so I googled and found some ways to only take the number of rows where I have data in column by, like below. I do have 2 Questions left.

1) Do I still need an IF statement for when the StrCriteria is Null? I would say no..

2) I am not able to find a way to only format column E and F as NumberFormat = "m/d/yyyy" That is why I just format the whole sheet....

Thanks!

Private Sub CommandButton1_Click()
  Set NewBook = Workbooks.Add
  Dim strCriteria As String
  Dim LR As Long



  AutoFilterMode = False
  strCriteria = InputBox("Enter MyCollis Username or Leave Empty for all")

  If strCriteria = vbNullString Then
  LR = Cells(Rows.Count, 2).End(xlUp).Row
  Sheet1.Range("A1:G" & LR).Copy

  Else
  Sheet1.[A1:G15000].AutoFilter Field:=7, Criteria1:=strCriteria
  LR = Cells(Rows.Count, 2).End(xlUp).Row
  Sheet1.Range("A1:G" & LR).Copy
  'Sheet1.[A1:G15000].Copy

  End If

  NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteValues)
  Selection.NumberFormat = "m/d/yyyy"

  UserId = Environ("Username")
  Path = "C:\Users\" & UserId & "\Desktop\"
  ActiveWorkbook.SaveAs Filename:=Path & "contracts" & "_" & strCriteria & "_" & (Format(Now(), "yyyymmdd")) & ".xlsx"

End Sub
Wilco
  • 1