How to create a weekly summary of entries contained on multiple worksheets...

[mritchi2]

Hi,

I've created a macro that searches and then auto populates a form based on customer details. It then keeps a record of customer contacts made by sales reps. I am now trying to add the functionality to produce a weekly report of activity by reps.

Each customers records are stored on its own worksheet, which is named as the respective customer number. I need the macro to loop through all of the customers worksheets and copy any active cells from B5 and down and to the right. If no cells are present I want to skip that customers worksheet and move on to the next one. Sheets that will not be included in this loop include: "Menu", "CustomerDetails", "Account", "Name", "Reference", "ReasonForCall" and "Temporary".

The information being copied from the customers worksheet to the summary will be contained in columns B:F, the date of the contact is contained in column B. I am hoping to filter the results contained in the summary by date, possibly using a MsgBox that allows you to select the chosen values.

I will also need a reference of the account number for each customer contact contained in the summary (which will be the name of the worksheet that the information is copied from). The summary will be compiled on worksheet "WeeklySummary", with the first entry starting on the 3rd row.

I've had a go with the coding below but it's all got a bit too complicated for my basic knowledge, any help would be much appreciated.

Sub WeeklySummary()
    Dim SH As Worksheet
    Dim rng As Range
    Dim rCell As Range
    Dim iCol As Long
    Dim iRow As Long
    
    Set rng = ActiveWorkbook.Sheets("CustomerDetails").Range("AccountList")
    For Each SH In ActiveWorkbook.Worksheets
    If Not IsError(Application.Match(SH.Name, rng, 0)) Then
    
    End If
    iMaxRow = 1000
    
    For iCol = 2 To 6
    For iRow = 5 To iMaxRow
        With Worksheets(SH).Cells(iRow, iCol)
            If .Value = "" Then
                
            Else
                .Copy Destination:=Worksheets("WeeklySummary").Cells(iRow, iCol)
            End If
        
        End With
    Next iRow
    Next iCol
    Next SH
    End Sub

 

[sijpie]

There are a number of errors and 'beauty faults', which I will address

Dim iRow as long

Nothing really wrong with this, but someone else looking at the code my thing iRow is an integer. So

Dim lRow as long, lCol as long

Then:

Dim SH as Worksheet

For each SH in ActiveWorkbook.Worksheets
   ...
   With Worksheets(SH).Cells

SH is a worksheet, so the last line will throw up an error. You have two options:

    With SH.Cells

or

      With Worksheets(SH.Name).Cells

the first one is of course the better.

    iMaxRow = 1000  ' you forgot to define this variable!!
    For lRow = 5 to iMaxRow
        ...
        If .Value = "" Then
        Else
            .Copy Destination etc
        End If

So first you forgot to declare iMaxRow. Always declare your variables.
Then you set iMaxRow to an arbitrarily number, which you think is high enough. What about in 5 years??
Next you go through the cells to see if they are not empty. But if they are empty we keep looping although nothing more will follow. Waste of time.

    lRow=5
    Do While .Cell(lRow, lCol) <> vbNullstring   'vbNullstring is an empty value
        .Cell(lRow, lCol).Copy
        lRow = lRow + 1
    Loop

OK then you loop through every cell of the five columns to copy each across if it contains something. That is very slow.
I am assuming that if the record is entered, it will contain something in all five columns. So why not just test for a value in the first column and then copy all five cells at once?
In fact, we don't even need to copy/paste (which is slow), but we can just set the values the same (which is fast).

    Do While .Cell(lRow, 2) <> vbNullstring   'vbNullstring is an empty value
        rOuput.Offset(lOut,2).Resize(1,5).Values = .Cell(lRow,2).Resize(1,5)[code]

What I am doing there is saying my output range (wich we still need to define) is 1 row high by five cols wide. And the value in those cells are the same as my current checked cell with its four columns to the right.

OK so then you get something like this:
<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br><br><SPAN style="color:#00007F">Sub</SPAN> WeeklySummary()<br>    <SPAN style="color:#00007F">Dim</SPAN> shInput <SPAN style="color:#00007F">As</SPAN> Worksheet, shOutput <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> rAccntLst <SPAN style="color:#00007F">As</SPAN> Range, rInp <SPAN style="color:#00007F">As</SPAN> Range, rOutp <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> lCol <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, lRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, lOutp <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">With</SPAN> ActiveWorkbook<br>        <br><SPAN style="color:#007F00">'        Set shOutput = Sheets("WeeklyReport-22")</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> shOutput = .Sheets.Add<br>        shOutput.Name = "WeeklyReport-" & Application.WorksheetFunction.WeekNum(Date, 1)<br>        <SPAN style="color:#00007F">Set</SPAN> rOutp = shOutput.Range("B5")<br>        lOutp = 0<br>        <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> shInput In ActiveWorkbook.Worksheets<br>            <SPAN style="color:#007F00">'test if sheet name is customer account nr</SPAN><br>            <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> IsError(Application.Match(shInput.Name, .Sheets("CustomerDetails").Range("AccountList"), 0)) <SPAN style="color:#00007F">Then</SPAN><br>            <br>                <SPAN style="color:#00007F">With</SPAN> shInput<br>                    lRow = 2<br>                    lCol = 2<br>                    <SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">While</SPAN> .Cells(lRow, lCol).Value <> vbNullString<br>                        <SPAN style="color:#007F00">' copy rows to report</SPAN><br>                        rOutp.Offset(lOutp, 0).Resize(1, 5).Value = .Cells(lRow, lCol).Resize(1, 5).Value<br>                        <SPAN style="color:#007F00">' copy customer number to end of row</SPAN><br>                        rOutp.Offset(lOutp, 6) = .Name<br>                        <SPAN style="color:#007F00">' increment input and output row counters</SPAN><br>                        lOutp = lOutp + 1<br>                        lRow = lRow + 1<br>                    <SPAN style="color:#00007F">Loop</SPAN><br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Next</SPAN> shInput<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

You notice at the top it has a statement Option Explicit
Put his at the top of every module, and then VBA will force you to dim your variables.

If you Dim a variable with at least one Capital letter, but when writing your code only use lower case letters then as oon as you go to the next line the Editor should capitalise your variable correctly: quick check for spelling mistakes!!

 

[sijpie]

I have assumed that your customer numbers are really strings. If they are numbers (ie they autoalign right) then you need to modify one line:

            If Not IsError(Application.Match(shInput.Name, .Sheets("CustomerDetails").Range("AccountList"), 0)) Then

should then become

            If Not IsError(Application.Match(cDbl(shInput.Name), .Sheets("CustomerDetails").Range("AccountList"), 0)) Then

 

[mritchi2]

Hi sijpie!

Your VBA knowledge is very impressive!
Thanks a lot for your help.

When I run the macro with the below code, the macro runs completely, however it does not produce any information on the weekly report. This worksheet remains completely blank.

            If Not IsError(Application.Match(shInput.Name, .Sheets("CustomerDetails").Range("AccountList"), 0)) Then

The customer numbers were in fact strings but i tried the alternative coding just in case and it produced a debug error for a type mismatch, as to be expected.

            If Not IsError(Application.Match(cDbl(shInput.Name), .Sheets("CustomerDetails").Range("AccountList"), 0)) Then

I have ensured there is data that should be picked up by the weekly report but it still comes up empty. Can you think of any reason why this would occur? I had tried to figure it out myself but your coding is a bit more advanced than my own VBA skills.

 

[sijpie]

Mmmh.

Let’s try some things. First of all my assumptions are as follows:
On your customer sheets the first entry to be copied is B2:F2
If B2 is empty then the macro will go to the next sheet. If B2 is the wrong starting cell you have to modify the start values for lRow and lCol
If the sheet name does not appear in your check list the macro will go to the next sheet.

So to test how the macro is doing in your sheet, try the following debugging:
Delete the empty weekly summary sheet. Now in the macro editor click the mouse somewhere in the macro. Now press the F8 key. What will happen is that you will step through the macro one line at a time, the yellow highlighted line will be processed with the next F8 press. Meanwhile you can also see what values the variables hold by hovering your mouse over them.

So keep pressing F8 until you have highlighted

If not isError(…) Then

Hover your mouse above ‘shInput.Name’. If it is one of the customer sheets then the macro should go into the If clause, else it should jump to ‘Next shInput’.
Press F8 once more – does it go into the If clause (if it was a customer sheet)?
If it behaved incorrectly then you need to let me know an example of a customer sheet name and its counterpart in AccountList.
If it did go into the If clause then continue to step through the lines until the

While .Cells

line. lRow and lCol should both be 2.
Press F8 once more, the macro should go into the loop, else B2 is empty.
Press F8 once more and now you can go to the spreadsheet to look into the new weekly summary sheet (if it wasn’t visible) and it should show the first data.
Click back on the macro editor before you continue pressing F8.
This is a simple way to see where your macro is going wrong.

My guess is that either the names of the sheets aren’t found or that B2 obn the sheets are empty.

Let me know.

 

[mritchi2]

Sorry for the delayed response sijpie!
I couldn't get this code to work, I'm not sure why but I have figured a way around it.
I now have a master list of records and the activity report summary simply filters this with a date range specified in a message box that automatically pops up.

I know it's not the most efficient method and it will likely require some form of archiving to manage the file size but it works for now.
I may re-address the issue once my VBA skills have improved...

Thanks a lot for your help!