Page 2 of 2 FirstFirst 12
Results 11 to 14 of 14

Thread: Repeat Values and Range of Dates Based on Cell Values
Thanks Thanks: 0 Likes Likes: 0

  1. #11
    Board Regular
    Join Date
    Jul 2007
    Location
    Sydney
    Posts
    4,392
    Post Thanks / Like
    Mentioned
    7 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Repeat Values and Range of Dates Based on Cell Values

    should always update for the entire calendar year (1/1 - 12/31)
    So the entered date in cell A1 of the "master sheet" has no bearing on this?

  2. #12
    New Member
    Join Date
    Sep 2017
    Posts
    30
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Repeat Values and Range of Dates Based on Cell Values

    The date entered in cell A1 on the master sheet controls the year in which the “sheet 2” will display

  3. #13
    Board Regular
    Join Date
    Jul 2007
    Location
    Sydney
    Posts
    4,392
    Post Thanks / Like
    Mentioned
    7 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Repeat Values and Range of Dates Based on Cell Values

    Hmmm...that doesn't answer the question

    I can't get the dates to copy down properly in any case I'm afraid I'm sure someone on the forum will be able though

  4. #14
    Board Regular
    Join Date
    Jul 2007
    Location
    Sydney
    Posts
    4,392
    Post Thanks / Like
    Mentioned
    7 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Repeat Values and Range of Dates Based on Cell Values

    Actually try this:

    Code:
    Option Explicit
    Sub Macro1()
    
        Dim wsSourceTab As Worksheet
        Dim wsOutputTab As Worksheet
        Dim strMyData() As String
        Dim lngArrayIndex As Long
        Dim lngLastRow As Long, lngMyRow As Long
        Dim rngMyCell As Range
        Dim intDay As Integer
    
        Application.ScreenUpdating = False
    
        Set wsSourceTab = Sheets("master sheet")
        Set wsOutputTab = Sheets("Sheet2") 'Change to suit
    
        'Clear any existing data
        lngLastRow = wsOutputTab.Range("A:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        If lngLastRow >= 3 Then
            wsOutputTab.Range("A3:B" & lngLastRow).ClearContents
        End If
    
        'Create an array of all the data to be copied
        lngLastRow = wsOutputTab.Cells(Rows.Count, "AB").End(xlUp).Row
        For Each rngMyCell In wsOutputTab.Range("AB2:AB" & lngLastRow)
            ReDim Preserve strMyData(lngArrayIndex)
            strMyData(lngArrayIndex) = rngMyCell.Value
            lngArrayIndex = lngArrayIndex + 1
        Next rngMyCell
    
        lngLastRow = wsOutputTab.Cells(Rows.Count, "AD").End(xlUp).Row
    
        For Each rngMyCell In wsOutputTab.Range("AD2:AD" & lngLastRow)
            For lngArrayIndex = LBound(strMyData) To UBound(strMyData)
                For intDay = 1 To Val(rngMyCell.Value)
                    If lngMyRow = 0 Then
                        lngMyRow = 3 'Initial output row. Change to suit if necessary.
                        Range("A" & lngMyRow).Value = CDate(intDay & "/" & Month(rngMyCell.Offset(0, -1)) & "/" & Year(wsSourceTab.Range("A1")))
                        Range("B" & lngMyRow).Value = strMyData(lngArrayIndex)
                    Else
                        lngMyRow = lngMyRow + 1
                        Range("A" & lngMyRow).Value = CDate(intDay & "/" & Month(rngMyCell.Offset(0, -1)) & "/" & Year(wsSourceTab.Range("A1")))
                        Range("B" & lngMyRow).Value = strMyData(lngArrayIndex)
                    End If
                Next intDay
            Next lngArrayIndex
        Next rngMyCell
    
        Application.ScreenUpdating = True
    
        MsgBox "Data has now been copied.", vbInformation
    
    End Sub
    Robert

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •