Search, Summarise and Total

[surya prakash]

Hi,
I am struck-up with a little problem, I am wondering if you could have look at.
I have posted my problem in the message board of MrExcel, it can be accessed at the following url

http://www.mrexcel.com/board2/viewto...1736&highlight=

thanks in advance
prakash

Happy christmas and wonderful new year

[Zack Barresse]

Hello,

Why don't you see if this works ...

Sub SummarizeMyData()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    Dim tmpWs As Worksheet, origWs As Worksheet, rngDescp As Range
    Dim rngTmp As Range
    Dim cel As Range, rng As Range, wf, fSpace As Long, i As Long
    Set origWs = ActiveSheet
    origWs.Range("E:F").ClearContents
    Set wf = Application.WorksheetFunction
    Set rngDescp = origWs.Range("B1:B" & origWs.Range("B65536").End(xlUp).Row)
    Set tmpWs = Worksheets.Add
    rngDescp.AdvancedFilter action:=xlFilterCopy, _
        copytorange:=tmpWs.Range("A1"), unique:=True
    If Err <> 0 Then
        MsgBox "There was a problem with your ranges!", vbInformation, "ERROR"
        Err.Clear
        Exit Sub
    End If
    Set rng = tmpWs.Range("A2:A" & tmpWs.Range("A65536").End(xlUp).Row)
    For Each cel In rng
        For i = 1 To Len(cel.Value) Step 1
            Select Case Mid(cel.Value, i, 1)
            Case Is = " ", Chr(32), Chr(160)
                fSpace = i
                Exit For
            End Select
        Next i
        If fSpace <> 0 Then
            cel.Value = Trim(Left(cel.Value, fSpace))
        Else 'No space, leave alone
        End If
    Next cel
    Set rngTmp = tmpWs.Range("A1:A" & tmpWs.Range("A65536").End(xlUp).Row)
    rngTmp.AdvancedFilter action:=xlFilterCopy, _
        copytorange:=tmpWs.Range("B1"), unique:=True
    For i = 1 To tmpWs.Range("B65536").End(xlUp).Row Step 1
        origWs.Range("E" & i).Value = tmpWs.Range("B" & i).Value
        If i <> 1 Then
            origWs.Range("F" & i).Formula = "=COUNTIF(B:B,E" & i & "&""*"")"
        End If
    Next i
    tmpWs.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Complete!"
End Sub

(As posted at MrE as well.)

[surya prakash]

Hi Zack,

It was nice to see your response so quickly.

Your solution is quite close to my requirements, only addition is second part (as you mentioned) which is to refer to another file called as inventory.xls for lookup values.

I am attaching my files along with the VBA code for your ready reference.

VBA is embedded in QFS-Sample02.xls; I have solution using match & index and SumIf. However, I am wondering if it is possible to achieve the same using VBA.

In the VBA code, I had hard-coded the reference values such as ?primary, secondary, roof sheeting? etc. These reference values are available in the file: ?Inventory2.xls? in column?d?. Can I avoid hard coding by automatically picking them using VBA.

Values generated by VBA are indicated in Red color and blue for the values generated using Excel functions.

Thanks for your time.

Surya prakash

[Zack Barresse]

Okay, quick question. Is it feasible to keep the Inventory sheet in the QFS-Sample02.xls file? Or is it a 'Global' file?

And to do the lookup by VBA, which is quite possible, we would need to have the file open. This could be done programmatically, but with the formulas should retain the last good value from when both were opened together. Is this the way you want to go for that (open programmatically)?

[surya prakash]

Hi Zack,

Thank you for your message.

Inventory.xls is global file; it contains definitions for many files similar to QFS-Sample02.xls. It is maintained separately without adding in QFS-Sample02.xls.

Inventry.xls can be opened & closed programmatically. User need not know that the file (inventory.xls) is opened.

I am wondering if it possible to do a lookup without having to insert lookup formula in the cell of excel sheet. I used a loop and counter to calculate the totals instead of inserting a ?sumif? function thro VBA.

Thanks

Prakash

[Jacob Hilderbrand]

You have a couple options. One easy way would be to put the formula into the cell with VBA. Then replace the formula with the value that is calculated from the formula.

For example:

Sheets("Sheet1").Range("A1").Value = "=MyFormulaHere"
Sheets("Sheet1").Range("A1").Value = Sheets("Sheet1").Range("A1").Value

Or you could use VBA to calculate the values. But like Zack stated, that would requre the other workbook(s) to be opened and then closed again.

[surya prakash]

Thank you Zack and DRJ,

VBA should open and close the reference file. And then update the values based on look-up. There is no problem here.

In the VBA code, I had hard-coded the reference values such as ?primary, secondary, roof sheeting? etc. These reference values are available in the file: ?Inventory2.xls? in column?d?. Can I avoid hard coding by automatically picking them using VBA.


Please refer to my post of 29-12-04 also.

Thanks again for your time, I really appreciate.

prakash

[Jacob Hilderbrand]

You could setup two columns of data somewhere then use those values in your If statement.

' Frame ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            If .Value = "Primary" Then
    Cells(rowindex, 11).Value = "Primary"
    ' Sub Totalling
    Wt_FR = Cells(rowindex, 8).Value
    BP_FR = Cells(rowindex, 10).Value
    TotWt_FR = TotWt_FR + Wt_FR
    TotBP_FR = TotBP_FR + BP_FR
' Purlins ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ElseIf .Value = "Secondaries" Then
    Cells(rowindex, 11).Value = "Secondaries"
    ' Sub Totalling
    Wt_SEC = Cells(rowindex, 8).Value
    BP_SEC = Cells(rowindex, 10).Value
    TotWt_SEC = TotWt_SEC + Wt_SEC
   TotBP_SEC = TotBP_SEC + BP_SEC

This could be changed to:

' Frame ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            If .Value = Range("A1").Text Then
    Cells(rowindex, 11).Value = Range("B1").Text
    ' Sub Totalling
    Wt_FR = Cells(rowindex, 8).Value
    BP_FR = Cells(rowindex, 10).Value
    TotWt_FR = TotWt_FR + Wt_FR
    TotBP_FR = TotBP_FR + BP_FR
    ' Purlins ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    mElseIf .Value = Range("A2").Text Then
    Cells(rowindex, 11).Value = Range("B2").Text
    ' Sub Totalling
    Wt_SEC = Cells(rowindex, 8).Value
    BP_SEC = Cells(rowindex, 10).Value
    TotWt_SEC = TotWt_SEC + Wt_SEC
    TotBP_SEC = TotBP_SEC + BP_SEC

Assuming the list of data could be placed in Columns A and B. But I would leave it coded the way you have it myself.

[surya prakash]

Hi DRJ,

Thank you for your response.

May be I have not explained my requirements clearly, here is what I am looking for:

QFS-Sample02.xls consists of bill-of-material of a building.
The material used in the building is classified into "Primary, secondary, sheeting, HR ... etc".

The items in QFS-Sample02.xls are classified based the classification given in the file inventory2.xls.

And the summary should be generated based on this.
Please check the attachment.

Thank you for your time.
Prakash

[Jacob Hilderbrand]

Ok, try this macro. Put it in a Module in QFS-Sample03.xls. Make sure both of your files are open and run the macro.

Option Explicit

Sub Macro1()
 
Dim i               As Long
Dim LastRow         As Long
Dim Cel             As Range
Dim TempVal         As String
With ThisWorkbook.Sheets("Test")
        LastRow = .Range("B65536").End(xlUp).Row
        .Range("H24:I31").ClearContents
        For i = 2 To LastRow
            TempVal = .Range("B" & i).Text
            If TempVal <> "" Then
                Set Cel = Workbooks("Inventory2.xls").Sheets("Reference"). _
                    Range("B:B").Find(What:=TempVal, LookIn:=xlValues, _
                    LookAt:=xlWhole, MatchCase:=True)
                If Not Cel Is Nothing Then
                    Select Case Trim(Cel.Offset(0, 1).Text)
                        Case Is = "Primary"
                            .Range("H24").Value = _
                                .Range("H24").Value + .Range("C" & i).Value
                            .Range("I24").Value = _
                                .Range("I24").Value + .Range("D" & i).Value
                        Case Is = "Secondaries"
                            .Range("H25").Value = _
                                .Range("H25").Value + .Range("C" & i).Value
                            .Range("I25").Value = _
                                .Range("I25").Value + .Range("D" & i).Value
                        Case Is = "Roof Shtg"
                            .Range("H26").Value = _
                                .Range("H26").Value + .Range("C" & i).Value
                            .Range("I26").Value = _
                                .Range("I26").Value + .Range("D" & i).Value
                        Case Is = "Wall Shtg"
                            .Range("H27").Value = _
                                .Range("H27").Value + .Range("C" & i).Value
                            .Range("I27").Value = _
                                .Range("I27").Value + .Range("D" & i).Value
                        Case Is = "T & F"
                            .Range("H28").Value = _
                                .Range("H28").Value + .Range("C" & i).Value
                            .Range("I28").Value = _
                                .Range("I28").Value + .Range("D" & i).Value
                        Case Is = "HR"
                            .Range("H29").Value = _
                                .Range("H29").Value + .Range("C" & i).Value
                            .Range("I29").Value = _
                                .Range("I29").Value + .Range("D" & i).Value
                        Case Is = "Anchor Bolts"
                            .Range("H30").Value = _
                                .Range("H30").Value + .Range("C" & i).Value
                            .Range("I30").Value = _
                                .Range("I30").Value + .Range("D" & i).Value
                        Case Is = "Accessories"
                            .Range("H31").Value = _
                                .Range("H31").Value + .Range("C" & i).Value
                            .Range("I31").Value = _
                                .Range("I31").Value + .Range("D" & i).Value
                    End Select
                End If
            End If
        Next i
    End With
End Sub

[Jacob Hilderbrand]

Also in your macro you have some declerations like this:

Dim BP_RS, TotBP_RS As Double
Dim BP_WS, TotBP_WS As Double
Dim BP_TF, TotBP_TF As Double
[/vba]
Note that only the last variable (for each line) has the data type of Double. The others are Variant. You can rewrite it like this:
[vba]
Dim BP_RS As Double, TotBP_RS As Double
Dim BP_WS As Double, TotBP_WS As Double
Dim BP_TF As Double, TotBP_TF As Double

Or

Dim BP_RS As Double
Dim TotBP_RS As Double
Dim BP_WS As Double
Dim TotBP_WS As Double
Dim BP_TF As Double
Dim TotBP_TF As Double

[surya prakash]

Hello DRJ,

Thank you for your prompt response.
I have just started on VBA and thank you so much for your valuable suggestions and help.

I am wondering if it possible to pick values from inventory.xls without opening the file?
However, QFS-sample03 will be always be open.

thanks
prakash

[Jacob Hilderbrand]

VBA cannot get values from a closed file, but you do have options.

1) Put formulas in cells on QFS-sample03 that links to the data you want, then have VBA get the data from those cells.

2) Have VBA put the formula into a cell, retrieve the value, then clear the cell.

3) Open the file, get the data, close the file. This can be done transparent to the user.

What option do you want to do?

[surya prakash]

Hi DRJ,

The 3rd option is excellent.
(Open the file, get the data, close the file. This can be done transparent to the user.)

I just happened to see a post on J-Walk's website, I am wondering if this can be adopted in our code (http://www.j-walk.com/ss/excel/tips/tip82.htm)

thanks
surya

[Jacob Hilderbrand]

You can use that code from j-walk as well.

Try this macro:

Option Explicit
 
Sub Macro1()
Dim AppExcel        As New Excel.Application
Dim Wkb             As Workbook
Dim Path            As String
Dim FName           As String
Application.EnableEvents = False
Path = "C:\" 'Path of the workbook
    FName = "NameOfFile"
    Set Wkb = AppExcel.Workbooks.Open(Filename:=Path & "\" & FName)
'Get the values here
    MyVariable =  Wkb.Sheets("SheetName").Range("RangeAddress").Text
Wkb.Close False
    AppExcel.Quit
Set Wkb = Nothing
    Set AppExcel = Nothing
    Application.EnableEvents = True
End Sub

[surya prakash]

Hi DRJ,
As I am a beginer, I am having a problem with comprehending and integrating your above code with the earlier code.

Can you kindly help.
thanks
surya

[Jacob Hilderbrand]

Try this. Right now I have the path of the workbook to open as ThisWorkbook.Path. So this will work if the two workbooks are in the same folder. If they are in different folders then change the path accordingly.

Option Explicit
  
 Sub Macro1()
Dim i               As Long
     Dim LastRow         As Long
     Dim Cel             As Range
     Dim TempVal         As String
     Dim AppExcel        As New Excel.Application
     Dim Wkb             As Workbook
     Dim Path            As String
     Dim FName           As String
Application.EnableEvents = False
'Path of workbook
     Path = ThisWorkbook.Path
'Name of workbook
     FName = "Inventory2.xls"
     Set Wkb = AppExcel.Workbooks.Open(Filename:=Path & "\" & FName)
With ThisWorkbook.Sheets("Test")
         LastRow = .Range("B65536").End(xlUp).Row
         .Range("H24:I31").ClearContents
         For i = 2 To LastRow
             TempVal = .Range("B" & i).Text
             If TempVal <> "" Then
                 Set Cel = Wkb.Sheets("Reference"). _
                 Range("B:B").Find(What:=TempVal, LookIn:=xlValues, _
                 LookAt:=xlWhole, MatchCase:=True)
                 If Not Cel Is Nothing Then
                     Select Case Trim(Cel.Offset(0, 1).Text)
                     Case Is = "Primary"
                         .Range("H24").Value = _
                         .Range("H24").Value + .Range("C" & i).Value
                         .Range("I24").Value = _
                         .Range("I24").Value + .Range("D" & i).Value
                     Case Is = "Secondaries"
                         .Range("H25").Value = _
                         .Range("H25").Value + .Range("C" & i).Value
                         .Range("I25").Value = _
                         .Range("I25").Value + .Range("D" & i).Value
                     Case Is = "Roof Shtg"
                         .Range("H26").Value = _
                         .Range("H26").Value + .Range("C" & i).Value
                         .Range("I26").Value = _
                         .Range("I26").Value + .Range("D" & i).Value
                     Case Is = "Wall Shtg"
                         .Range("H27").Value = _
                         .Range("H27").Value + .Range("C" & i).Value
                         .Range("I27").Value = _
                         .Range("I27").Value + .Range("D" & i).Value
                     Case Is = "T & F"
                         .Range("H28").Value = _
                         .Range("H28").Value + .Range("C" & i).Value
                         .Range("I28").Value = _
                         .Range("I28").Value + .Range("D" & i).Value
                     Case Is = "HR"
                         .Range("H29").Value = _
                         .Range("H29").Value + .Range("C" & i).Value
                         .Range("I29").Value = _
                         .Range("I29").Value + .Range("D" & i).Value
                     Case Is = "Anchor Bolts"
                         .Range("H30").Value = _
                         .Range("H30").Value + .Range("C" & i).Value
                         .Range("I30").Value = _
                         .Range("I30").Value + .Range("D" & i).Value
                     Case Is = "Accessories"
                         .Range("H31").Value = _
                         .Range("H31").Value + .Range("C" & i).Value
                         .Range("I31").Value = _
                         .Range("I31").Value + .Range("D" & i).Value
                     End Select
                 End If
             End If
         Next i
     End With
Wkb.Close False
     AppExcel.Quit
Set Wkb = Nothing
     Set AppExcel = Nothing
     Application.EnableEvents = True
End Sub

[surya prakash]

Hello DRJ,

Thank you so much for your time; your suggestions works perfect for me.

However, I am wondering if the following can be read from the excel cell

Case Is = "Primary" 
Case Is = "Secondaries"

This is particularly useful, if my look-up's such as "Primary", "Secondaries" etc are more and can be directly read from a location say G24:G31 (or G50) in QFS-example03.xls sheet.

Thanks again for your time
prakash

[Jacob Hilderbrand]

That can be done as well.

Case Is = Range("G24").Text
  Case Is = Sheets("Sheet1").Range("G24").Text
  Case Is = Workbooks("MyWorkbook.xls").Sheets("Sheet1").Range("G24").Text

[surya prakash]

Hi DRJ,
Thank you very much indeed for your help.