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/viewtopic.php?t=121736&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.

[Jacob Hilderbrand]

You're Welcome

Take Care