What when the week doesn't begin in the correct month

Hi there.

In the previous question we got a code that picks data from one sheet to another, according to some rules and a specific date.  It begins at Tuesday and goes through the sheet until Saturday.

The problem I found is what the 1st of the month isn´t a Tuesday (code begin)?
Example: December, 1st was a Thursday.
With the code as it is I get a error message informing that the week´s starting date (29/11) is not found in the target workbook.clientsheet since it begins at 01/12 (dd.mm format)
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Are you asking a design question or a programming question?
QuickstepbrAuthor Commented:
Programming question.
QuickstepbrAuthor Commented:
We also have to consider that the month can end before Saturday.
2012/01/31 will be a Tuesday.
PMI ACP® Project Management

Prepare for the PMI Agile Certified Practitioner (PMI-ACP)® exam, which formally recognizes your knowledge of agile principles and your skill with agile techniques.

I disagree.  You have source data for which you do not have target slots.  That is a design issue.

You posted workbooks that represent the context/framework of the data movement.  

If you failed to include data at the end of a month or data that crossed month boundaries, I would have no reason to ask you about such a condition.  I did ask you about the beginning of the month.

As with the prior related question, you should specify exactly what needs to happen and under what circumstances.  Upload workbooks with data that tests these conditions.  It would be helpful for the experts to see a before and an after version of the target workbook so that the experts can validate their code results.
QuickstepbrAuthor Commented:
I´m not saying that your code is wrong or something like that.
It is perfect for what was asked. But only when working with it today I saw that my presentation was not specific enough. As a non expert it is difficult for me to preview all possibilities.

Source wb are received from sales personnel every week and cover only data for that week.
When summing up all weeks I saw that my question was incomplete.

What I need is actually expand what is already done.
There are some more things I need the code to be doing but I will address this in future questions.
I think it is easier to solve one problem at a time.

Please accept my apologies if I gave to understand that your code was not ok.
You have a target area for each client that covers a calendar month and includes a total for that month.  The end-of-month (EOM) condition is something that is part of the design of the workbook and application.

I can tweak the code to prevent an error, but I suspect that you will need to redesign your target worksheets if you want to see this EOM+ data.
QuickstepbrAuthor Commented:
I see that I couldn't explain my self correctly.

I don´t think that the target wb is the issue, but the source wb.

Attached file shows how November ends in the middle of the week / December begins in the middle of the week.

November part of the week I need to copy to target file CG-1111 and December part of the week I need to copy to target file CG-1112.
It is ok to run the code twice. Once for each target wb.

I need the code to ignore days in the source wb before and after current month. (current month is given by the target wb)
November part of the week I need to copy to target file CG-1111 and December part of the week I need to copy to target file CG-1112.
It is ok to run the code twice. Once for each target wb.

I need the code to ignore days in the source wb before and after current month. (current month is given by the target wb)

That's a bit (self) contradictory.  If the code ignores days outside of the current month, then no November 2011 or January 2012 days will be copied.
QuickstepbrAuthor Commented:
My main work tools are the target wb.
For each month of the year I have one file. (Examples: CG-1101, CG-1102, CG-1103 and so on)
(all target wb). Current month is is given by a cell in target workbook ("Capa".D3). Based on this given date the code could check if the data to be imported are from the correct month.

Current month in target wb: December (CG-1112)
Let us assume I want to import data from posted above (Controle-de-devolu--es--111128.xlsx )
Source wb, 1st day: 11/29
Source wb, Last day: 12/03.
As far as I understand it until now I would say that the code should ignore whatever from the last month and begin to import data from 12/01 onwards.
(If I would be importing data for the last week of November, the code should import Data until 11/30 and ignore the rest of the week)(Given that the target file for November is another one)

How would you handle a source wb with information about 2 different months, since the information   for a given week are partially from one month and partially from the next.
I get the month from the target workbook.worksheet("Cada") D3 cell and added an If...End If structure that will prevent the data transfer if the target month is not the same as the source month.  So you would run this for each source month, selecting a different target workbook.

Also, I added code that compares the date in the prior iteration's rngTgt to eliminate unnecessary date search.

Option Explicit

Public Function GetWks(parmWksType As String, Optional parmUnit = "worksheet") As Worksheet
    Dim varReply As Variant
    On Error Resume Next
    Set varReply = Application.InputBox("Select any cell in the " & parmWksType & " " & parmUnit, "Get " & parmWksType & " Worksheet", , , , , , 8)
    If TypeOf varReply Is Range Then
        Set GetWks = varReply.Worksheet
    End If
End Function

Public Sub CopyData()
    Dim dicTgtWks As Object
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim wkbSrc As Workbook
    Dim wkbTgt As Workbook
    Dim wksSrc As Worksheet
    Dim wksTgt As Worksheet
    Dim vItem As Variant
    Dim rngSrc As Range
    Dim rngTgt As Range
    Dim rngCell As Range
    Dim dtCurrent As Date
    Dim lngTgtMonth As Long
    Dim lngCurrent As Long
    Dim lngSrcOffsets() As Variant
    Dim lngLoop As Long
    Dim lngTgtOffset As Long
    lngSrcOffsets = Array(11, 14, 17, 20, 23, 26)
    Set wksSrc = GetWks("Source")
    If wksSrc Is Nothing Then
        MsgBox "Source not selected", vbCritical
        Exit Sub
    End If
    Set wksTgt = GetWks("Target", "workbook")
    If wksTgt Is Nothing Then
        MsgBox "Target not selected", vbCritical
        Exit Sub
        Set wkbTgt = wksTgt.Parent
        lngTgtMonth = Month(wkbTgt.Worksheets("Capa").Range("D3").Value)
    End If
    If IsDate(wksSrc.Range("B1").Value) Then
        dtCurrent = wksSrc.Range("B1").Value
        lngCurrent = CLng(dtCurrent)
        MsgBox "Initial Source date (B1) not set", vbCritical
        Exit Sub
    End If
    On Error GoTo 0
    Set dicTgtWks = CreateObject("Scripting.dictionary")
    For Each wks In wkbTgt.Worksheets
        If IsNumeric(wks.Range("A1").Value) And (wks.Range("A1").Value > 0) Then
            If dicTgtWks.exists(wks.Range("A1").Value) Then
                MsgBox "Duplicate client number (" & wks.Range("A1").Value & ") encountered in target workbook" & vbCr & "Please correct and rerun the CopyData routine", vbCritical
                Exit Sub
                dicTgtWks.Add wks.Range("A1").Value, wks
            End If
        End If
    Set rngSrc = wksSrc.Range(wksSrc.Range("A2"), wksSrc.Range("A" & wksSrc.Cells.SpecialCells(xlCellTypeLastCell).Row))
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    On Error Resume Next
    For Each rngCell In rngSrc
        Select Case True
            Case IsNumeric(rngCell.Value) And (rngCell.Value > 0)
                If Month(dtCurrent) = lngTgtMonth Then      'ensure month target affinity
                    Set wksTgt = dicTgtWks(rngCell.Value)
                    If wksTgt Is Nothing Then
                        MsgBox rngCell.Value & " not found in target worksheets" & vbCr & "Please correct and rerun the CopyData routine", vbCritical
                        Exit Sub
                    End If
                    If rngTgt Is Nothing Then
                        Set rngTgt = wksTgt.Cells(24, 4)
                    End If
                    If wksTgt.Cells(24, rngTgt.Column).Value2 = lngCurrent Then
                        Set rngTgt = wksTgt.Cells(24, rngTgt.Column)
                        For Each rngTgt In wksTgt.Range("24:24")
                            If rngTgt.Value2 = lngCurrent Then
                                Exit For
                            End If
                            If rngTgt.Value = "Total" Then
                                Set rngTgt = Nothing
                                Exit For
                            End If
                    End If
                    If rngTgt Is Nothing Then
                        MsgBox Day(dtCurrent) & " not found in " & wksTgt.Name & " worksheets", vbCritical
                        Exit Sub
                    End If
                    'copy the data from source col offsets to target row offsets
                    lngTgtOffset = 0
                    For Each vItem In lngSrcOffsets
                        lngTgtOffset = lngTgtOffset + 2
                        rngTgt.Offset(lngTgtOffset, 0).Value = rngCell.Offset(0, vItem).Value
                End If
            Case IsDate(rngCell.Offset(0, 1).Value)     'new source date
                dtCurrent = rngCell.Offset(0, 1).Value
                lngCurrent = CLng(dtCurrent)
        End Select
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Open in new window


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
QuickstepbrAuthor Commented:
Very good.
Does the job perfectly.
Once again Aikimark did not only the job, but has helped me to develop my understanding of the issues.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.