CODEWITHSUNDEEP
excelvba
Wilco
Wilco

Reputation: 1

New at VBA, any suggestions to my code?

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

Upvotes: 0

Views: 66

Answers (3)

Wilco
Wilco

Reputation: 1

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

Upvotes: 0

Wilco
Wilco

Reputation: 1

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!

Upvotes: 0

Bob Phillips
Bob Phillips

Reputation: 437

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"

Upvotes: 2

Related Questions