Search VBA Code here

Sunday
Jul152007

Automatically create a text file that gets saved as todays date: VBA Excel

Sub TextFileCreate()
    
    Close #1
    Open Application.Text(Now(), "dd mm yyyy") & ".TXT" For Output As #1
    
    Close #1
    
End Sub

Sunday
Jul152007

Count number of used columns: VBA Excel

lNumCols = lWrkSht.UsedRange.Columns.count

Sunday
Jul152007

Count number of used ROWS: VBA Excel

lNumRows = lWrkSht.UsedRange.Rows.count

or

Range("A65536").End(xlup).Select


 

Sunday
Jul152007

Combine multiple workbooks into one: VBA Excel

Sub CombineFiles()
    'combines multiple Excel files into one sheet
    Dim TargetSht As Worksheet
    Dim i As Integer
    Dim Wks As Worksheet

    Application.ScreenUpdating = False

    Set TargetSht = ThisWorkbook.ActiveSheet

    With Application.FileSearch
       'the file open code is Shawn Foley's code
        .NewSearch
        .LookIn = "c:\xlFiles\"              'folder to use
        .SearchSubFolders = False
        .FileName = "*.xls"
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute() > 0 Then
            MsgBox "There were " & .FoundFiles.Count & " file(s) found."
            For i = 1 To .FoundFiles.Count
                Workbooks.Open .FoundFiles(i)
                For Each Wks In ActiveWorkbook.Worksheets
                    Wks.UsedRange.Copy Destination:= _
                    TargetSht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

                  Next Wks
                ActiveWorkbook.Close False
            Next i
        Else
            MsgBox "There were no files found."
        End If
    End With
Application.ScreenUpdating = True

End Sub

Sunday
Jul152007

Check to see if file is open before opening: VBA Excel


Dim NewWB as workbook
Set NewWb = Workbooks(CStr(Month(Now) & " " & Day(Now) & " " & Year(Now)) & ".xls")

If NewWb Is Nothing Then
  Set NewWb = Workbooks.Add
      With NewWb
          .Title = CStr(DateValue(Now))
          .Subject = "MTB GL Statement"
          .SaveAs Filename:=CStr(Month(Now) & " " & Day(Now) & " " & Year(Now)) & ".xls"
          .SaveAs Filename:=Application.GetSaveAsFilename(fileFilter:="Excel Files (*.xls), *.xls")
      End With
End If

Sunday
Jul152007

Browse for file and return path: VBA Excel

Function GetFolderName(Optional OpenAt As String) As String
    Dim lCount As Long
    
    GetFolderName = vbNullString
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = OpenAt
        .Show
        For lCount = 1 To .SelectedItems.Count
            GetFolderName = .SelectedItems(lCount)
        Next lCount
    End With
End Function

Sunday
Jul152007

Automatically add new sheet with today's date: VBA Excel

Sub Add_Sheet()
Dim wSht As Worksheet
Dim shtName As String
shtName = Format(Now, "mmmm_yyyy")
For Each wSht In Worksheets
    If wSht.Name = shtName Then
        MsgBox "Sheet already exists...Make necessary " & _
            "corrections and try again."
        Exit Sub
    End If
Next wSht
    Sheets.Add.Name = shtName
    Sheets(shtName).Move After:=Sheets(Sheets.Count)
    Sheets("Sheet1").Range("A1:A5").Copy _
        Sheets(shtName).Range("A1")
End Sub