Creating Summary Report by using VBA Code

Question

hi All,

pls consider the following detailed Report for billing :

Now, management required a summary report , the figures of the same should be linked with the detailed report . The summary report should look like following :

However, the following Sub Procedure created by me was running successfully with a limitation that the figures are not linked with main data. The code of the same is as follows:

Sub CreatingSummaryReports() 

Dim cell As Range 

Dim Rng As Range 

Dim Cellone As Range 

Set Cellone = Application.InputBox("Select Value", Type:=8) 

Set Rng = Sheets(1).Range("F:F").Find(What:=Cellone.Value, LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False) 

Set cell = Rng.CurrentRegion.Find(What:="TOTAL", Lookat:=xlWhole) 

Range("B7").Value = Cellone.Value 

Range("B7").Offset(0, 1).Value = cell.Offset(0, 6).Value 

End Sub

However, based on the same code I created a function procedure like the following. The purpose was to create a linked summary report.

Function CreatingSummaryReport(Cellone As Range) as long

Dim cell As Range 

Dim Rng As Range 

Set Rng = Sheets(1).Range("F:F").Find(What:=Cellone.Value, LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False) 

Set cell = Rng.CurrentRegion.Find(What:="TOTAL", Lookat:=xlWhole) 

CreatingSummaryReport = cell.Offset(0, 6).Value 

End Function

The above function code is not working and producing "#VALUE" . However, I have examined that the following line item (circled in Red) NOT Working in Function code :

Pls let me know what changes to be done in the function code so that the same runs successfully.

Regards,

Somnath

Answer 1

Hi Somnath

I'm AnnaThomas and I'd be happy to help you with your question. In this Forum, we are Microsoft consumers just like yourself.

It looks like the problem is with the line:

CreatingSummaryReport = cell. Offset(0, 6). Value

The function is expected to return a value of type Long, but the cell object may not be found, and in that case, its Offset property will return an error. You should add error handling to ensure that the function returns a value only when the cell is found. You can use the On Error Resume Next statement to skip over any errors and return a value of 0 in case the cell is not found.

Here is an updated version of the function:

Function CreatingSummaryReport(Cellone As Range) As Long

Dim cell As Range Dim Rng As Range

On Error Resume Next

Set Rng = Sheets(1). Range("F:F"). Find(What:=Cellone.Value, LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False)

If Rng Is Nothing Then CreatingSummaryReport = 0 Exit Function End If

Set cell = Rng.CurrentRegion.Find(What:="TOTAL", Lookat:=xlWhole)

If cell Is Nothing Then CreatingSummaryReport = 0 Exit Function End If

CreatingSummaryReport = cell. Offset(0, 6). Value

End Function

With these changes, the function will return 0 if either the Rng or cell objects are not found, and otherwise return the value of the Offset property.

I hope this helps ;-), let me know if this is contrary to what you need, I would still be helpful to answer more of your questions.

Best Regards,

AnnaThomas

Give back to the community. Help the next person with this problem by indicating whether this answer solved your problem. Click Yes or No at the bottom.

Answer 2

Try this macro:

Sub CopyValues() 

Dim a As Integer, lr As Integer, sh2 As Worksheet 

Set sh2 = Sheets(2) 

sh2.Columns("a:b").ClearContents 

With Sheets(1) 

lr = .Range("b" & .Rows.Count).End(xlUp).Row 

a = 0 

For x = 2 To lr 

If .Range("b" & x).Value = "TOTAL" Then 

a = a + 1 

sh2.Range("a" & a).Value = .Range("b" & x).Offset(-1, 4).Value 

sh2.Range("b" & a).Value = .Range("b" & x).Offset(0, 6).Value 

End If 

Next x 

sh2.Columns("a:b").AutoFit 

End With 

End Sub