CODEWITHSUNDEEP
vbaexcel
Learner_VBA
Learner_VBA

Reputation: 23

Auto sum the values till the first encounter of blank cell in a column

Am trying to open a new workbook and sum the values in the Column "A" and paste in the first blank cell. But the sum doesn't show in the blank cell.

Path = ActiveWorkbook.Path
Filename = InputBox("Enter an input file name")
MsgBox Filename
InputFile = Path & "\"

InputFile = InputFile & Filename
MsgBox InputFile
Workbooks.Open Filename:=InputFile

'Activating the Raw Data Report
Set InputFile = ActiveWorkbook
Set InputFileSheet = InputFile.Sheets("Sheet1")
InputFileSheet.Select
InputFileSheet.Activate

Set r = Range(Range("A1"), Cells(Rows.Count, "A"))
Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = Application.WorksheetFunction.Sum(r)

Upvotes: 0

Views: 1000

Answers (2)

whytheq
whytheq

Reputation: 35557

Some small changes and I think your routine can be shortened:

Dim Path As String, Filename As String, InputFile As String
Path = Excel.ActiveWorkbook.Path
Filename = InputBox("Enter an input file name")
InputFile = Path & "\" & Filename

MsgBox InputFile

Excel.Workbooks.Open Filename:=InputFile

 'Activating the Raw Data Report
Dim rawData As Excel.Workbook
Set rawData = Excel.Workbooks(Filename)

Dim r As Excel.Range
With rawData.Sheets("Sheet1")
   Set r = .Range(.Range("A1"), .Cells(.Rows.Count, "A"))
   .Range("A" & .Cells(.Rows.Count, 1).End(Excel.xlUp).Row + 1) = Excel.Application.WorksheetFunction.Sum(r)
End With

If your code needs to go into a full production system then you need to start thinking more defensively about your code. Santosh's answer gives lots of help on ways to achive a more defensive style.

Upvotes: 1

Santosh
Santosh

Reputation: 12353

Try below code:

  • Copy the below code and paste to any module.

  • Kindly save the file before you run.

  • The code will ask for workbook to be selected which you want to open.

  • Once you select the workbook it will sum the values for column A and put in last cell.

Sub test()
    Dim Path As String
    Dim fileName As String
    Dim wkb As Workbook

    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.AllowMultiSelect = False


    Dim FileChosen As Integer

    FileChosen = fd.Show

    fd.Title = "Summary Data"
    fd.InitialView = msoFileDialogViewSmallIcons


    fd.Filters.Clear
    fd.Filters.Add "Excel macros", "*.xls*"


    fd.FilterIndex = 1


    If FileChosen <> -1 Then
        MsgBox "You chose cancel"
        Path = vbNullString
    Else
        Path = fd.SelectedItems(1)
    End If

    If Path <> vbNullString Then
        fileName = GetFileName(Path)

        If IsWorkBookOpen(Path) Then
            Set wkb = Workbooks(fileName)
        Else
            Set wkb = Workbooks.Open(fileName)
        End If

        If Not wkb Is Nothing Then
            With wkb.Sheets("sheet1")
                Set r = .Range(.Cells(1, 1), .Cells(.Rows.Count, "A"))
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = Application.WorksheetFunction.Sum(r)
            End With
        End If
    End If
End Sub

Function GetFileName(fullName As String, Optional pathSeparator As String = "\") As String

    Dim i As Integer
    Dim iFNLenght As Integer
    iFNLenght = Len(fullName)

    For i = iFNLenght To 1 Step -1
        If Mid(fullName, i, 1) = pathSeparator Then Exit For
    Next

    GetFileName = Right(fullName, iFNLenght - i)

End Function

Function IsWorkBookOpen(fileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open fileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
    Case 0: IsWorkBookOpen = False
    Case 70: IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function

Upvotes: 1

Related Questions