none
Sum multiple like rows of imported.txt file based on criteria in column 1 using VBA RRS feed

  • Question

  •  Hello. I have a file that imports into Excel using VBA, does some manipulations, and exports the result to a comma delimited file on a daily basis. Below is a small sample of data. 

    I must now sum the contents of column D for all rows whose column A are equal.  For instance, in the sample below, I need to add column D of rows 2 and 3 together and put the result in column G of rows 2 and 3.  Then I would need to sum the contents of column D for rows 4,5, and 6 and put the result in column G for rows 4,5, and 6.  In other words, sum the rows in Column D whose column A are equal. The input will consist of hundreds of rows.

    I do not know how to go about doing this.  Can anybody help?

    Thank you.

    Debbi

      A                      B                  C                       D                      E                                              F

    1 ID Name Term Balance Descr Acct Type
    2 437389 Doe, John 2015 Fall 88.75 Bookstore Charges BKS
    3 437389 Doe, John 2015 Fall 444.45 Tuition TUT
    4 541231 Doe, Jane  2015 Fall 94.75 Bookstore Charges BKS
    5 541231 Doe, Jane  2015 Fall 100.14 Tuition TUT
    6 541231 Doe, Jane  2015 Fall 85.16 BookStore Charges BKS

    Here is the existing code:


    ' Create_CHARGES_file Macro
    '
    Dim sFname As String
    Dim sFile As String
    Dim i As Integer
    Dim strEmplid As String
    Dim strFirst As String
    Dim strLast As String
    Dim strAcct As String
    Dim strNewLine As String
    Dim strMaxChg
    Dim strAcctNbr
    Dim strContinue As String
    Dim strpath
    Dim strQueryFile
    Dim strWB
    Dim strDate As String
    Dim intResult As Integer
    Dim intWriteCt As Integer


        strMaxChg = "800.00"   'max bookstore charge amount
        intWriteCt = 0         'number of lines written to output file
        strAcctNbr = " "       'bookstore account number

        strContinue = "N"
        Do Until IsNumeric(strAcctNbr)  'repeat prompt for account # until a number is entered or Cancel is clicked
            strAcctNbr = Application.InputBox(Prompt:="Enter Bookstore Acct#:", Title:="Bookstore Account Number")
            If strAcctNbr <> False Then  'user didn't press Cancel
                If IsNumeric(strAcctNbr) Then
                  strContinue = "Y"
                Else
                  MsgBox "Account Number must be entered and must be numeric"
                End If
            End If
        Loop
              
        If strContinue = "Y" Then   'if no errors
            strDate = Format(Date, "mmddyy")
            strpath = "T:\bookstore\"
            strWB = strAcctNbr & "FABooklist" & strDate & ".xls"
            strQueryFile = strpath & strWB
            If Dir(strQueryFile) = "" Then 'if input spreadsheet isn't found
                strContinue = "N"
                MsgBox "Spreadsheet " & strQueryFile & " does not exist"
                ThisWorkbook.Close
            End If
        Else
            strContinue = "N"
        End If
       
        If strContinue = "Y" Then  'if no errors
       
            Application.ScreenUpdating = False  'hide screen processing - improves performance
                  
            Workbooks.Open Filename:=strQueryFile  'open the input spreadsheet
            Workbooks(strWB).Activate

            ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Add Key:=Range("G3:G5000") _
                , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Add Key:=Range("E3:E5000") _
                , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Add Key:=Range("B3:B5000") _
                , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets("sheet1").Sort
                .SetRange Range("A2:N5000")
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
          
           If strAcctNbr = "197" Then
               strDate = "0" & strDate
           End If
          
           sFile = strAcctNbr & "Bookcharges" & strDate & ".txt"
           sFname = strpath & sFile
          
           i = FreeFile
           Open sFname For Output As #i
          
           Range("B3").Select
          
           Do While Not IsEmpty(ActiveCell.Offset(0, 0).Value) 'process until a blank cell in column B (ID) is reached
          
                If ActiveCell.Offset(0, 2).Value > 0 And IsNumeric(ActiveCell.Offset(0, 2)) Then
          
                    strEmplid = ActiveCell.Offset(0, 0).Value
                    strFirst = ActiveCell.Offset(0, 3).Value
                    strLast = ActiveCell.Offset(0, 5).Value
                   
                    strNewLine = ",,,,," & Chr(34) & strEmplid & Chr(34) & "," & _
                                 Chr(34) & strFirst & Chr(34) & ",," & _
                                 Chr(34) & strLast & Chr(34) & _
                                 ",,,,,,," & Chr(34) & _
                                 Chr(34) & "," & Chr(34) & strEmplid & Chr(34) & _
                                 ",,,,,,,,,,," & _
                                 Chr(34) & strMaxChg & Chr(34) & ",,," & _
                                 Chr(34) & strAcctNbr & Chr(34) & _
                                 ",,,,,,,"
                   
                    Print #i, strNewLine
                   
                    intWriteCt = intWriteCt + 1
               
                End If
               
                ActiveCell.Offset(1, 0).Select  'advance to the next row
          
           Loop
           
           Close #i
          
           ActiveWorkbook.Close SaveChanges:=False
           Application.ScreenUpdating = True
          
           MsgBox "File  " & sFile & "  was successfully created." & Chr(10) & Chr(10) & _
                  "Lines written:  " & intWriteCt  'display the # of lines written for comparison to the spreadsheet row count
          
           intResult = Shell("Notepad.exe " & sFname, vbMaximizedFocus) 'open the file in Notepad
           
        End If
       
        ThisWorkbook.Close
       
    End Sub









    Monday, September 14, 2015 2:32 PM

Answers

  • Below the line that opens the file, insert

            Dim n As Long
            n = Range("B" & Rows.Count).End(xlUp).Row
            Range("G2:G" & n).Formula = "=SUMIF($B$2:$B$" & n & ",$B2,$D$2:$D$" & n & ")"


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Monday, September 14, 2015 3:43 PM
  • Let's say you want to subtract the value in column G from the value in column H and place the result in column J. Add the following line below the code that I posted earlier in this thread:

            Range("I2:I" & n).Formula = "=$H2-$G2"


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, September 16, 2015 1:54 PM

All replies

  • Below the line that opens the file, insert

            Dim n As Long
            n = Range("B" & Rows.Count).End(xlUp).Row
            Range("G2:G" & n).Formula = "=SUMIF($B$2:$B$" & n & ",$B2,$D$2:$D$" & n & ")"


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Monday, September 14, 2015 3:43 PM
  • Hi DBeVille,

    This is the forum to discuss questions and feedback for Microsoft Excel, I'll move your question to the MSDN forum for Excel

    http://social.msdn.microsoft.com/Forums/en-US/home?forum=exceldev&filter=alltypes&sort=lastpostdesc

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.

    Regards,

    Emi Zhang
    TechNet Community Support


    Please remember to mark the replies as answers if they help, and unmark the answers if they provide no help. If you have feedback for TechNet Support, contact tnmff@microsoft.com.

    Tuesday, September 15, 2015 7:31 AM
  • Thank you, Hans!  This accomplished what I needed.
    Tuesday, September 15, 2015 5:27 PM
  • Hi, Hans

    Is there a way to take the result from the formula,

    • Dim n As Long
              n = Range("B" & Rows.Count).End(xlUp).Row
              Range("G2:G" & n).Formula = "=SUMIF($B$2:$B$" & n & ",$B2,$D$2:$D$" & n & ")"

    subtract it from the value in a different column, and place the new value in a new column?

    Thank you.

    Wednesday, September 16, 2015 12:50 PM
  • Let's say you want to subtract the value in column G from the value in column H and place the result in column J. Add the following line below the code that I posted earlier in this thread:

            Range("I2:I" & n).Formula = "=$H2-$G2"


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, September 16, 2015 1:54 PM
  • Thank you again, Hans!  It worked like a charm.
    Thursday, September 17, 2015 12:48 PM