PDA

View Full Version : VBA Sum If Calculation



hobbiton73
08-01-2013, 01:12 AM
Hi, I wonder whether someone may be able to help me please.

I have a 'Source' data sheet containing the following columns of information.


List of project codes, allocated the named range of "ProjectName".
List of dates, allocated the named range of "Period".
List of numerical calues, allocated the named range "Actuals".


These lists can contain duplicate entries so the information could look like this:





PROJECTNAME



PERIOD



ACTUALS



Test01

Apr 13

5



Test02

Apr 13

10



Test01

Apr 13

2



Test01

May 13

3



Test02

May 13

5



Test01

Jun 13

25



Test01

Aug 13

7





I then have a 'Destination' sheet which has the following columns:


List of unique project codes allocated the named range of "EnhancementsList".
Currently empty column allocated the named range of "EApr".
Currently empty column allocated the named range of "EMay".
Currently empty column allocated the named range of "EJun".
Currently empty column allocated the named range of "EJul".
Currently empty column allocated the named range of "EAug".
Currently empty column allocated the named range of "ESep".
Currently empty column allocated the named range of "EOct".
Currently empty column allocated the named range of "ENov".
Currently empty column allocated the named range of "EDec".
Currently empty column allocated the named range of "EJan".
Currently empty column allocated the named range of "EFeb".
Currently empty column allocated the named range of "EMar".


The code below is the piece of script which creates the list of unique values from the "ProjectName" range, pasting these into the "EnhancementsList" range.


With CreateObject("scripting.dictionary")
For Each MyCell In Range("ProjectName").Value
If InStr(1, MyCell, "Enhancements") > 0 Then
.Item(MyCell) = 1
End If
Next
Range("EnhancementsList").Resize(.Count) = Application.Transpose(.keys)
End With

I'd now like to amend this code to include the following functionality, but I have to admit I'm not sure where to begin:


When the search for unique values is performed in the "ProjectName" range, also look in the "Period" named range.
When these are both identical, sum the values in the "Actuals" named range and paste as follows:


Against each entry in the "EnhancementList" range add any associated April actuals to the "EApr" column range, May actuals in the "EMay" column etc.

So using the table above, the resulting information would be:



ENHANCEMENTSLIST

EApr

EMay

EJun

EJul

EAug

ESep

EOct

ENov

EDec

EJan

EFeb

EMar



Test01

7

3

25


7










Test02

10

5














I appreciate that this may not be the most straight forward post and there is a lot of detail, but I just wondered whether someone could possibly take a look at this please and offer some guidance on how I may go about achieveing this.

Many thanks and kind regards

Doug Robbins
08-01-2013, 02:05 AM
The following code will populate the Enhancement List and also insert the totals by project by period into the respective cells on the Destination Sheet:


Dim i As Long, j As Long, m As Long
Dim strProject As String
Dim RDate As Date
Dim RVal As Long
Dim BlnProjExists As Boolean
With Sheets("Source").Range("A1")
For i = 1 To .CurrentRegion.Rows.Count - 1
strProject = .Offset(i, 0)
RDate = .Offset(i, 1)
RVal = .Offset(i, 2)
With Sheets("Destination").Range("A1")
If .CurrentRegion.Rows.Count = 1 Then
.Offset(1, 0) = strProject
j = 1
Else
BlnProjExists = False
For j = 1 To .CurrentRegion.Rows.Count - 1
If .Offset(j, 0) = strProject Then
BlnProjExists = True
Exit For
End If
Next j
If BlnProjExists = False Then
.Offset(j, 0) = strProject
End If
End If
Select Case RDate
Case "Apr 13"
m = 1
Case "May 13"
m = 2
Case "Jun 13"
m = 3
Case "Jul 13"
m = 4
Case "Aug 13"
m = 5
Case "Sep 13"
m = 6
Case "Oct 13"
m = 7
Case "Nov 13"
m = 8
Case "Dec 13"
m = 9
Case "Jan 14"
m = 10
Case "Feb 14"
m = 11
Case "Mar 14"
m = 12
End Select
.Offset(j, m) = .Offset(j, m) + RVal
End With
Next i
End With

hobbiton73
08-01-2013, 02:33 AM
Hi @Doug Robbins, thank you very much for taking the time to reply to my post and the time and trouble for putting the code together.

I've tried your solution, and unchanged, the information unfortuantely didn't copy across.

So I amended the code, changing the areas in bold to the following:



With Sheets("AllData").Range("ProjectName")
For i = 1 To .CurrentRegion.Rows.Count - 1
strProject = .Offset(i, 0)
RDate = .Offset(i, 1)
RVal = .Offset(i, 2)
With Sheets("Enhancements").Range("EnhancementsList")
If .CurrentRegion.Rows.Count = 1 Then
.Offset(1, 0) = strProject
j = 1
Else
BlnProjExists = False
For j = 1 To .CurrentRegion.Rows.Count - 1
If .Offset(j, 0) = strProject Then
BlnProjExists = True
Exit For
End If
Next j
If BlnProjExists = False Then
.Offset(j, 0) = strProject
End If
End If
Select Case RDate
Case "Apr 13"
m = 1
Case "May 13"
m = 2
Case "Jun 13"
m = 3
Case "Jul 13"
m = 4
Case "Aug 13"
m = 5
Case "Sep 13"
m = 6
Case "Oct 13"
m = 7
Case "Nov 13"
m = 8
Case "Dec 13"
m = 9
Case "Jan 14"
m = 10
Case "Feb 14"
m = 11
Case "Mar 14"
m = 12
End Select
.Offset(j, m) = .Offset(j, m) + RVal
End With
Next i
End With
End Sub



But unfortunately, I receive the following error:

Run-time error '13': Type Mismatch and debug highlights this line as the issue:


strProject = .Offset(i, 0)

I just wondered whether you may be able to tell me please where I've gone wrong.

Many thanks and kind regards

Doug Robbins
08-01-2013, 03:54 AM
If the names of your sheets are All Data and Enhancements, change the sheet names, BUT LEAVE the .Range("A1") as I had it is.

hobbiton73
08-01-2013, 04:05 AM
Hi, thank you very much for coming back to me with this.

I've amended the code as you suggested, but although, I don't recieve any error message the information isn't copied across.

May I just ask, is there a reason why "A1" is used rather than the range name. I'm just curious.

Many thanks and kind regards

Doug Robbins
08-01-2013, 05:58 AM
Range(A1) is the first cell on the sheet and the code is processing cells that are offset from that cell.

I suggest that you post a copy of your workbook so that I can see exactly what it is that you have. My code processed a workbook set up as in your sample to produce the output in you question

hobbiton73
08-01-2013, 10:26 AM
Hi @Doug Robbins, thank you very much for your continued help, and my apologies for not getting back to you sooner. The server was busy.

Please find attached the file you asked me to provide.

Please click on the button on the "Macros" page to run the code.

Many thanks and kind regards

Doug Robbins
08-01-2013, 02:53 PM
Given the layout of your worksheets, which differ significantly from that suggested in your original post (I can never understand why people leave empty rows above and empty columns to the left) and the formatting of your data, you will need to use


Sub Unique()
Dim i As Long, j As Long, m As Long
Dim strProject As String
Dim RDate As Date
Dim RVal As Single
Dim BlnProjExists As Boolean

With Sheets("AllData").Range("E3")
For i = 1 To .CurrentRegion.Rows.Count - 1
strProject = .Offset(i, 0)
RDate = .Offset(i, 3)
RVal = .Offset(i, 4)
With Sheets("Enhancements").Range("B3")
If .CurrentRegion.Rows.Count = 1 Then
.Offset(1, 0) = strProject
j = 1
Else
BlnProjExists = False
For j = 1 To .CurrentRegion.Rows.Count - 1
If .Offset(j, 0) = strProject Then
BlnProjExists = True
Exit For
End If
Next j
If BlnProjExists = False Then
.Offset(j, 0) = strProject
End If
End If
Select Case Format(RDate, "mmm yy")
Case "Apr 13"
m = 2
Case "May 13"
m = 3
Case "Jun 13"
m = 4
Case "Jul 13"
m = 5
Case "Aug 13"
m = 6
Case "Sep 13"
m = 7
Case "Oct 13"
m = 8
Case "Nov 13"
m = 9
Case "Dec 13"
m = 10
Case "Jan 14"
m = 11
Case "Feb 14"
m = 12
Case "Mar 14"
m = 13
End Select
.Offset(j, m) = .Offset(j, m) + RVal
End With
Next i
End With
End Sub

parttime_guy
08-01-2013, 07:16 PM
Hi All,

I have created a solution based on Vlookup (just have a look and let me have your comments) - hope you find it helpfull

Best Regards :friends:

Doug Robbins
08-01-2013, 11:47 PM
Unfortunately, your Vlookup solution does not handle the summation of the two Test01 Project records with Actuals for Apr 13.

parttime_guy
08-02-2013, 07:55 PM
Hi Doug,

Thanks - point noted :doh:, I have changed the formula to sumif giving the same results.

I would suggest you include a clear all function in the your latest vba code because each time you Click button the figures keep on increasing in the result sheet.

Regards :friends:

Doug Robbins
08-02-2013, 11:19 PM
Commands to clear any existing data now included:


Sub Unique()
Dim i As Long, j As Long, m As Long
Dim strProject As String
Dim RDate As Date
Dim RVal As Single
Dim BlnProjExists As Boolean
With Sheets("Enhancements").Range("B3")
For i = 1 To .CurrentRegion.Rows.Count - 1
For j = 0 To 13
.Offset(i, j) = ""
Next j
Next i
End With
With Sheets("AllData").Range("E3")
For i = 1 To .CurrentRegion.Rows.Count - 1
strProject = .Offset(i, 0)
RDate = .Offset(i, 3)
RVal = .Offset(i, 4)
With Sheets("Enhancements").Range("B3")
If .CurrentRegion.Rows.Count = 1 Then
.Offset(1, 0) = strProject
j = 1
Else
BlnProjExists = False
For j = 1 To .CurrentRegion.Rows.Count - 1
If .Offset(j, 0) = strProject Then
BlnProjExists = True
Exit For
End If
Next j
If BlnProjExists = False Then
.Offset(j, 0) = strProject
End If
End If
Select Case Format(RDate, "mmm yy")
Case "Apr 13"
m = 2
Case "May 13"
m = 3
Case "Jun 13"
m = 4
Case "Jul 13"
m = 5
Case "Aug 13"
m = 6
Case "Sep 13"
m = 7
Case "Oct 13"
m = 8
Case "Nov 13"
m = 9
Case "Dec 13"
m = 10
Case "Jan 14"
m = 11
Case "Feb 14"
m = 12
Case "Mar 14"
m = 13
End Select
.Offset(j, m) = .Offset(j, m) + RVal
End With
Next i
End With
End Sub

hobbiton73
08-03-2013, 06:20 AM
Hi @Doug Robbins, thank you so much for putting this together, it's simply brilliant!

May I just ask please, if you could possibly help me with another query which is add on of the scenario you kindly provided the code for. There are two scenarios I hadn't anticipated when I sent my original post. All I can offer is my sincere apologies.



The first scenario is for the code to specifically look for the text value "Enhancements" in the "ProjectName" range. When it finds this, then follow the same copy and paste procedure as per your code.
The second scenario would be if the text value of "OVH" is present in the "ProjectName" range, it it is, offset one column to the left and take that value, and apply the same copy and paste procedure as per your code.


I appreciate that these might serve better as separate scripts, that's absolutely fine. As my confidence grows I can sort out the ranges etc which I'll need to create.

As I've said, I really am very sorry for messing you around and taking up more of your time.

Many thanks and kind regards

Doug Robbins
08-03-2013, 07:42 AM
So it is only for records that have the text value "Enhancements" that shoud be acted upon by the code that I have provided?

You should really provide a typical example.

Ditto for the OVH case, please provide a proper example.

hobbiton73
08-03-2013, 08:15 AM
Hi @Doug Robbins, thank you very much for coming back to me with this so quickly.

The code you've kindly submitted is great for one of the scenarios which I need to work with, so that can stay as is, if at all possible please.

As mentioned in the my previous post, and I have to admit not explained particularly well, the next scenario is if any cell in the "ProjectName" range on the "AllData" sheet contains the text value "Enhancements", then as per your previous code, create a unique list and paste this and the associated "Actuals" values into the "Enhancements" page.

The second scenario is if any cell in the "ProjectName" range, again on the "AllData" sheets contains the text value "OVH", move one column to the left and take the value from that column which incidentally has the range name of "Task". Then as per your original code, create a list of unique values from the "Task" range, rather than the "ProjectName" range and once again sum the "Actuals" values. For the purposes of making the demo easier to navigate it's ok to also paste this information into the "Enhancements" page. In reality I'll be writing the code to move this to another page.

I'm thinking that maybe three separate scripts may be better, and because I'll be looking at how you've put these together, easier for me to understand.

As requested I've attached a file to illustrate this.

Once again, many thanks and kind regards

Doug Robbins
08-03-2013, 03:21 PM
Is "13-14 Enhancements to be treated" the same way as "Enhancements" and if so is it the same Project or a different Project?
What about the following entries under Project Name:

Enh
TM
Test02

Are they to be ignored?

I note that you have changed the layout of the Enhancements sheet again. You must realise that code cannot, without going to some lenght handle such variabilities and if you want assistance you must make your requirements very clear. Otherwise you just waste peoples time and you will not get assistance.

It would be far better if you posted an actual example of the data that you want to process rather than what appears to be a mockup of it. And don't DRIP FEED YOUR REQUIREMENTS!

hobbiton73
08-04-2013, 05:58 AM
Hi @Doug Robbins, firstly thank you for taking the time to come back to me, and secondly my sincere apologies for causing you offence, this is certainly not my intention.

The reason I attached the 'mock-up' is because the live data I hold is confidential, so I'm sure you'll understand why I've not been able to include this in the file I attached. As you've correctly pointed out, I have made some minor changes to the spreadsheet. I'm very sorry, I didn't realise and perhaps appreciate how this may seem to you. The very last thing I want to do is waste your time. I can confirm that I will not be changing the layout any further and this will be how it looks in the live environment.

In respect of the "Enhancements" query you raised, yes, basically any entry which contains the text value "Enhancements" are to be treated the same.

The same also applies to the second scenario I highlighted where the text value is "OVH", in that all cells containing this value are to be treated the same.

With regard to the other values i.e. "Enh", "TM", and "Test02", then yes, these can be ignored, but I will still be using the script you've already kindly provided elsewhere.

What I was hoping is that you could perhaps show me the way please on how to achieve the "Enhancements" and "OVH" scenario, which I could then learn from and use to form my own scripts should the need arise, I hope this is ok.

Once again, my sincere apologies for causing you offence, and I hope that the above answers your queries.

Many thanks and kind regards

Doug Robbins
08-05-2013, 01:55 AM
Sub Unique()
Dim i As Long, j As Long, m As Long
Dim strProject As String
Dim RDate As Date
Dim RVal As Single
Dim BlnProjExists As Boolean
With Sheets("Enhancements").Range("B3")
For i = 1 To .CurrentRegion.Rows.Count - 1
For j = 0 To 13
.Offset(i, j) = ""
Next j
Next i
End With
With Sheets("AllData").Range("E3")
For i = 1 To .CurrentRegion.Rows.Count - 1
If InStr(.Offset(i, 0), "Enhancements") > 0 Then
strProject = .Offset(i, 0)
ElseIf InStr(.Offset(i, 0), "OVH") > 0 Then
strProject = .Offset(i, -1)
Else
GoTo Nexti
End If
RDate = .Offset(i, 3)
RVal = .Offset(i, 4)
With Sheets("Enhancements").Range("B3")
If .CurrentRegion.Rows.Count = 1 Then
.Offset(1, 0) = strProject
j = 1
Else
BlnProjExists = False
For j = 1 To .CurrentRegion.Rows.Count - 1
If .Offset(j, 0) = strProject Then
BlnProjExists = True
Exit For
End If
Next j
If BlnProjExists = False Then

hobbiton73
08-05-2013, 08:25 AM
Hi thank you very much for this, it is truly appreciated, but unfortunately I'm unable to get this to work.

When I ran the code I received a 'Compile error: Label not defined' message, highlighting this line as the issue:
GoTo Nexti.

So I changed this to
GoTo Next i so that it fit with how the variable had been declared, but I'm still receiving a compile error.

Would it be possible please that you could have a look at this and let me know where I've gone wrong?

Many thanks and kind Regards

hobbiton73
08-09-2013, 12:30 AM
All,

In additon to the solution provided by @Doug Robbions, further help received from the 'Stackoverflow' helped me to overcome the problems I had with the above solution and put together a working script as below.


Sub Unique()
Dim i As Long, j As Long, m As Long
Dim strProject As String
Dim RDate As Date
Dim RVal As Single
Dim BlnProjExists As Boolean
With Sheets("Enhancements").Range("B3")
For i = 1 To .CurrentRegion.Rows.Count - 1
For j = 0 To 13
.Offset(i, j) = ""
Next j
Next i
End With
With Sheets("AllData").Range("E3")
For i = 1 To .CurrentRegion.Rows.Count - 1
strProject = .Offset(i, 0)
If InStr(.Offset(i, 0), "Enhancements") > 0 Then
strProject = .Offset(i, 0)
ElseIf InStr(.Offset(i, 0), "OVH") > 0 Then
strProject = .Offset(i, -1)
Else
GoTo NextLoop
End If
RDate = .Offset(i, 3)
RVal = .Offset(i, 4)
With Sheets("Enhancements").Range("B3")
If .CurrentRegion.Rows.Count = 1 Then
.Offset(1, 0) = strProject
j = 1
Else
BlnProjExists = False
For j = 1 To .CurrentRegion.Rows.Count - 1
If .Offset(j, 0) = strProject Then
BlnProjExists = True
Exit For
End If
Next j
If BlnProjExists = False Then
.Offset(j, 0) = strProject
End If
End If
Select Case Format(RDate, "mmm yy")
Case "Apr 13"
m = 1
Case "May 13"
m = 2
Case "Jun 13"
m = 3
Case "Jul 13"
m = 4
Case "Aug 13"
m = 5
Case "Sep 13"
m = 6
Case "Oct 13"
m = 7
Case "Nov 13"
m = 8
Case "Dec 13"
m = 9
Case "Jan 14"
m = 10
Case "Feb 14"
m = 11
Case "Mar 14"
m = 12
End Select
.Offset(j, m) = .Offset(j, m) + RVal
End With
NextLoop:
Next i
End With
End Sub

Many thanks and kind regards