how to use lookup to sum columns

[John Bortoli]

Hi all,
I have a VBA macro used in autocad which uploads data to an excel spread sheet.
I was wondering if someone can help me.
Column B contains a number which could be 1,2,3,4 etc
I would like to be able to get VBA to lookup col B and for every instance of 1 then add the corresponding row data for columns F,H I J and place the sum for each at the side of the sheet. see attached file

In Anticipation Thanks
John B

The VBA code from autocad which loads the spreadsheet is as below

Option Explicit

'Extracts attributes from Tendon ID bubble to excel

Sub Pmark()
Dim Excel As Object
Dim ExcelSheet As Object
Dim RowNum As Integer
Dim Array1 As Variant
Dim cnt As Integer
Dim NumberOfAttributes As Integer
Dim Ssnew As AcadSelectionSet
Dim Sheet As Object
Dim Max As Integer
Dim Min As Integer
Dim NoOfIndices As Integer
Dim blkRef As AcadBlockReference
Dim objAtt As AcadAttributeReference
Dim objEnt As AcadEntity
Dim x As Long
' Start Excel if not running
On Error Resume Next
Set Excel = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set Excel = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Could Not Load Excel!", vbExclamation
End
End If
End If
On Error GoTo 0
Excel.Visible = True
Excel.Workbooks.Add '............................
Excel.Worksheets(1).Select

Set ExcelSheet = Excel.ActiveSheet
ExcelSheet.Name = "BOM"                               '<-- change sheet name to suit
''Clear the cells
ExcelSheet.range("A12", "DZ100").Clear
ExcelSheet.range("A12:O12").Font.Bold = True

'Get Selection Set of Specific Block with Attributes
RowNum = 12
Dim Header As Boolean
Header = False
' The following sets up a selection set from the user for all objects
On Error Resume Next
' create set
Set Ssnew = ThisDrawing.SelectionSets.Add("BOM")
'if statement handles possible selection set error
If Err.Number <> 0 Then
   Set Ssnew = ThisDrawing.SelectionSets.Item("BOM")
   Ssnew.Clear
End If

Dim GC(0 To 1) As Integer
Dim GV(0 To 1) As Variant
Dim atribs
GC(0) = 0
GV(0) = "INSERT"
GC(1) = 2
'---------------------------------------------------
'Revise the block name "cable1" for your application
GV(1) = "cable1"
'---------------------------------------------------
Ssnew.Select acSelectionSetAll, , , GC, GV
For Each objEnt In Ssnew
   Set blkRef = objEnt
   Array1 = blkRef.GetAttributes
For cnt = LBound(Array1) To UBound(Array1)
   Set objAtt = Array1(cnt)
   If Header = False Then
   ExcelSheet.Cells(RowNum, cnt + 1).Value = objAtt.TagString
End If
Next cnt
RowNum = RowNum + 1
For cnt = LBound(Array1) To UBound(Array1)
   Set objAtt = Array1(cnt)
   ExcelSheet.Cells(RowNum, cnt + 1).Value = objAtt.TextString
Next cnt
Header = True
Next
'some formatting goes here:
With ExcelSheet.UsedRange
    .Columns.AutoFit
    Dim headRng As Excel.range
Set headRng = .range(Cells(1, 1), Cells(1, UBound(Array1) + 1))
   With headRng
       .Borders.LineStyle = xlContinuous
       .Interior.ColorIndex = 35
       .Font.ColorIndex = 5
   End With
Dim dataRng As Excel.range
    Set dataRng = .range(Cells(2, 1), Cells(.Rows.Count, UBound(Array1) + 1))
         dataRng.Select
    With Excel.Selection
        .Sort Key1:=range("B12"), Order1:=xlAscending, Key2:=range("A12") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
        .Borders.LineStyle = xlContinuous
        .Font.ColorIndex = 9
        .Interior.ColorIndex = 34


x = 4.2366

Debug.Print (Round(x, 2))

    
    End With
End With

Set dataRng = Nothing
Set headRng = Nothing
Set ExcelSheet = Nothing
Ssnew.Delete
End Sub

[David A Coop]

Hi John,

SORRY PROTONLEAH - I JUST SAW YOUR POST

First of all, you may receive a note from admin re the posting of code without the HTML code markers because the way you posted it makes it very difficult to read. However, the code seems to be irrelevant to the problem at hand.

Having said that, I don't think you need VBA code to populate the matrix at Q1:U15.
in R13 use =SUMPRODUCT(--($B$13:$B$60=$Q13)*$F$13:$F$60) and copy down
in S13 use =SUMPRODUCT(--($B$13:$B$60=$Q13)*$I$13:$I$60) and copy down
in T13 use =SUMPRODUCT(--($B$13:$B$60=$Q13)*($J$13:$J$60=T$12)) and copy right and down.

I hope this helps, please let me know!

Regards,

David


- Please click on the *Add Reputation button at the bottom of helpful responses.

Please mark your thread as SOLVED:
- Click Thread Tools above your first post, select "Mark your thread as Solved".

[John Bortoli]

Hi David,
That's a simple way of looking at it and is a great help. My expertise is in AutoCAD and not Excel as you can see.
I have followed your advice and refined my results to expand my summary.
One I am stuck on is I wish to calculate the length of 50,70 and 90 duct required to each pour.
to do this we need to lookup b13-b100 that is equal to r13 then sum column F values for each pour which is equal to t12,v12 and u12. I tried but it doesn't seem to work for me.

On another note is it possible that this result sheet could be on a second sheet of the same workbook as I suspect I may need to create a template file on which autocad dumps the main data and on the second sheet the info is automatically updated.
regards
John

[protonLeah]

comment deleted

[protonLeah]

On Ben's summary sheet:

Galv Dct 50: (C3)

=SUMPRODUCT(--(PourNumber=$A3),--(DuctSize=C$2),DuctLength)

Length (B3): =SUM(C3:E3)

Tendon Tonnage, Kg (F3):

=SUMPRODUCT(--(PourNumber=$A3)*(TendonTonnage)*(DuctSize=$C$2:$E$2))

---------------------------
PourNumber (typical named range) --> B13:B69

[John Bortoli]

Hi Guys,
I have just realised that I need to add another condition to Davids answer as given in Post #2.
Column D can vary and have a value of either 12.7mm or 15.2mm.
Basically the simple formula would need to meet the following

If B13-B100=R13 and G13-G100=S12 and D13-D100=R10 then sum the values in F13-F100 that meet the criteria and place the result in cell S13

I have no idea how to manage this but am sure with some guidance will be able to make it all work.

I have re-attached my file for your information.

Your help is greatly appreciated
John

[David A Coop]

Sorry for the delay getting back to you. I have been very distracted over the Christmas/New Year period.

I think all you need to do as add that extra bit to the formula :
=SUMPRODUCT(--($B13:$B100=$R13),--($G13:$G100=S$12),--($D$13:$D$100=$R$10),$F13:$F100)

I hope this helps, please let me know!

Regards,

David


- Please click on the *Add Reputation button at the bottom of helpful responses.

Please mark your thread as SOLVED:
- Click Thread Tools above your first post, select "Mark your thread as Solved".

[John Bortoli]

Thanks for your help and for the birthday wishes from the forum last week.
The code in Post #1 extracts autocad attribute data opens excel at a new workbook, and dumps the data into the blank workbook which I then use save-as to save the file.
What do I need to do to this code to open an existing worksheet instead.
I now have a standard template file named post_BOM.xltm set up which I now wish to use as my base excel workbook to dump the autocad data.
Regards
John Bortoli

[John Bortoli]

Hi where can I find edit to fix the code