PDA

View Full Version : VBA Yearly Extract



hobbiton73
05-08-2014, 07:46 AM
Hi, I wonder whether someone may be able to help me please.

I made a post here http://www.excelforum.com/excel-programming-vba-macros/1008263-vba-create-yearly-extract-using-column-headings.html in respect of a problem I was encountering in adapting existing code.

I was very fortunate in receiving two possible solutions, with which I chose the one kindly provided by @Leith Ross.

As you will see from the link above, in particular message #13, that I've come across a problem which I've tried to engage with the author of the code, but sadly been unable to do.


I've noticed that in the case of where there is a row of data on the "All Data" sheet with a date in column J prior to my first column on the "Desired Output" sheet i.e. "April 14", although the value is correctly not paste to this sheet, the "Description", column I on the "All Data" Sheet is still shown in column B on the "Desired Output" sheet, thus creating a blank row.

As you also see I have tried over the last couple of days to find a solution, my knowledge has let me down.

I just wondered whether someone could possibly look at this and offer some guidance on how I may overcome the problem, or indeed, if you feel that there is a better solution offer guidance on how I can overcome my original problem.

I've uploaded the file here: https://www.dropbox.com/s/jfpcepzxzb0zb7u/Sum%20Categories%20Test2%20ver%201%20Re-submitted.xls

Many thanks and kind regards

Chris

Bob Phillips
05-08-2014, 09:04 AM
Does this do it?


Sub YearlyExtract()

Dim AFTE As Single
Dim BlnProjExists As Boolean
Dim ColDates As New Collection
Dim DeO As Worksheet
Dim EH As Worksheet
Dim Flex As String
Dim i As Long
Dim IND As Worksheet
Dim j As Long
Dim JRole As String
Dim LastRow As Long
Dim m As Long
Dim OVH As Worksheet
Dim PCode As String
Dim PDate As Date
Dim PLOB As String
Dim PRO As Worksheet
Dim Project As String
Dim RLOB As String
Dim RngDates As Range
Dim Task As String

Application.ScreenUpdating = False

Const StartRow As Long = 8
Set DeO = Sheets("Desired Output")

For i = 4 To DeO.Cells(StartRow - 1, Columns.Count).End(xlToLeft).Column
m = m + 1
ColDates.Add m, DeO.Cells(StartRow - 1, i).Text
Next i

With Sheets("All Data").Range("F7")
For i = 1 To .CurrentRegion.Rows.Count - 1
PLOB = .Offset(i, -4) ' Column B
RLOB = .Offset(i, -3) ' Column C
JRole = .Offset(i, -1) ' Column E
Project = .Offset(i, 0) ' Column F
Task = .Offset(i, 3) ' Column I
PDate = .Offset(i, 4) ' Column J
AFTE = .Offset(i, 8) ' Column N
Flex = .Offset(i, 9) ' Column O

If InStr(.Offset(i, 0), "TM - DIR") > 0 And InStr(.Offset(i, -1), "BAS") = 0 And _
RLOB = "C&R" And Flex = "Yes" And AFTE > 0 And _
.Offset(i, 4).Value >= Application.Min(DeO.Rows(7)) Then
RLOB = .Offset(i, -3)
JRole = .Offset(i, -1)
Task = .Offset(i, 3)

With DeO.Range("B7")
If .CurrentRegion.Rows.Count = 1 Then
.Offset(1, 0) = Task
.Offset(1, 1) = RLOB
j = 1
Else
BlnProjExists = False
For j = 1 To .CurrentRegion.Rows.Count - 1
If .Offset(j, 0) = Task And .Offset(j, 1) = RLOB Then
BlnProjExists = True
Exit For
End If
Next j
If BlnProjExists = False Then
.Offset(j, 0) = Task
.Offset(j, 1) = RLOB
End If
End If

On Error Resume Next
m = ColDates(Format(PDate, "mmm yy"))
If Err = 0 Then .Offset(j, m + 1) = .Offset(j, m + 1) + AFTE
On Error GoTo 0
End With
End If
Next i
End With
End Sub

hobbiton73
05-08-2014, 10:25 AM
Hi @xld, thank you very much, once again to take the time to help me out with this.

I don't really know what to say because the code works brilliantly and returns the correct results, thank you so much.

You know me of old, and I just wondered whether it may be possible for you to include some comments in the code please.

Once again sincere thanks and kind regards

Chris

Bob Phillips
05-08-2014, 11:00 AM
It's not my code, I am not going to comment someone else's code. All ll I did was add an extra test within the IF of


And _
.Offset(i, 4).Value >= Application.Min(DeO.Rows(7))

which just checks if the date in the current row, as defined by the variable i, is within the range of dates on the destination sheet, which is row 7.

hobbiton73
05-09-2014, 05:52 AM
Hi @xld, I completely understand, how stupid of me to ask.

Many thanks and kind regards.

Chris

Bob Phillips
05-09-2014, 06:26 AM
Hi @xld, I completely understand, how stupid of me to ask.


Chris, didn't mean to appear sharp. I rarely comment my own code, life is too short to comment someone else's :)

hobbiton73
05-09-2014, 10:47 AM
Hi @xld, no that's absolutely no problem at all. :)

All the very best and take care.

Chris