Tilen
Tilen

Reputation: 15

copy paste by dates from one worksheet to anoter

I have days in a month sorted form Cell A to AH (eg: 1.1.2021 is A, 2.1.2021 is B and so on), and I need to copy those values to another worksheet. My code works, but is too long for all 31 days (error: function is too large). Is there any way to optimize it or sort it by arrays? for the other days its identical code except the part from where it gets values now it gets from "jan" worksheet cells "C", if it's 2nd day it should get values from Cells "D" eg: 1st day of month:Worksheets("List1").Range("I16").Value = Worksheets("Jan").Range("C10").Value; 2nd day of month: Worksheets("List1").Range("I16").Value = Worksheets("Jan").Range("D10").Value

code looks like this:

Function TEST()
    Dim Day, Month As Variant
    Day = Range("V6").Value
    Month = Range("V5").Value

    If Month = 1 Then
        Worksheets("List1").Range("I16").Value = Worksheets("Jan").Range("C10").Value 
        Worksheets("List1").Range("N6").Value = Worksheets("Jan").Range("C18").Value 
        Worksheets("List1").Range("T5").Value = Worksheets("Jan").Range("C12").Value 
        Worksheets("List1").Range("T6").Value = Worksheets("Jan").Range("C11").Value 
        Worksheets("List1").Range("T7").Value = Worksheets("Jan").Range("C23").Value 
        Worksheets("List1").Range("D6").Value = Worksheets("Jan").Range("C7").Value 
        Worksheets("List1").Range("D7").Value = Worksheets("Jan").Range("C19").Value 
        Worksheets("List1").Range("Z7").Value = Worksheets("Jan").Range("C3").Value 
        Worksheets("List1").Range("Y7").Value = Worksheets("Jan").Range("C16").Value 
        Worksheets("List1").Range("Z6").Value = Worksheets("Jan").Range("C4").Value 
        Worksheets("List1").Range("Y6").Value = Worksheets("Jan").Range("C17").Value 
        Worksheets("List1").Range("N7").Value = Worksheets("Jan").Range("C5").Value 
        Worksheets("List1").Range("M16").Value = Worksheets("Jan").Range("C2").Value 
        Worksheets("List1").Range("D16").Value = Worksheets("Jan").Range("C16").Value 
        Worksheets("List1").Range("Y9").Value = Worksheets("Jan").Range("C15").Value 
        Worksheets("List1").Range("N11").Value = Worksheets("Jan").Range("C9").Value 
        Worksheets("List1").Range("Z8").Value = Worksheets("Jan").Range("C8").Value 
        Worksheets("List1").Range("Y8").Value = Worksheets("Jan").Range("C21").Value 
    ElseIf Day = 2 Then
        Worksheets("List1").Range("I16").Value = Worksheets("Jan").Range("D10").Value 
        Worksheets("List1").Range("N6").Value = Worksheets("Jan").Range("D18").Value 
        '....etc
    End If
End Function

Upvotes: 1

Views: 63

Answers (3)

VBasic2008
VBasic2008

Reputation: 54817

Import Data by Month and Day

  • Note that you're writing C16 to D16 and to Y7.

Standard Module e.g. Module1

Option Explicit

Sub ImportData()

    Const sfCol As Variant = "C" ' or 3
    Dim sRows As Variant: sRows = VBA.Array( _
        10, 18, 12, 11, 23, 7, 19, 3, 16, 4, _
        17, 5, 2, 16, 15, 9, 8, 21)
        
    Const dName As String = "List1"
    Const dMonthAddress As String = "V5"
    Const dDayAddress As String = "V6"
    Dim dAddresses As Variant: dAddresses = VBA.Array( _
        "I16", "N6", "T5", "T6", "T7", "D6", "D7", "Z7", "Y7", "Z6", _
        "Y6", "N7", "M16", "D16", "Y9", "N11", "Z8", "Y8")
    Dim dMonths As Variant: dMonths = VBA.Array( _
        "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", _
        "Nov", "Dec")
        
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim dws As Worksheet
    On Error Resume Next
    Set dws = wb.Worksheets(dName)
    On Error GoTo 0
    If dws Is Nothing Then
        MsgBox "Destination worksheet not found."
        Exit Sub
    End If
    
    Dim dMonth As Variant: dMonth = dws.Range(dMonthAddress).Value
    If IsNumeric(dMonth) Then
        dMonth = CLng(dMonth)
    Else
        MsgBox "Month is invalid"
        Exit Sub
    End If
    If dMonth < 1 Or dMonth > 12 Then
        MsgBox "Month is out of bounds."
        Exit Sub
    End If
    
    Dim dDay As Variant: dDay = dws.Range(dDayAddress).Value
    If IsNumeric(dDay) Then
        dDay = CLng(dDay)
    Else
        MsgBox "Day is invalid."
        Exit Sub
    End If
    If dDay < 1 Or dDay > 31 Then
        MsgBox "Day is out of bounds."
        Exit Sub
    End If
    
    Dim sws As Worksheet
    On Error Resume Next
    Set sws = dws.Parent.Worksheets(Application.Index(dMonths, dMonth))
    On Error GoTo 0
    If sws Is Nothing Then
        MsgBox "Month worksheet does not exist."
        Exit Sub
    End If
    
    Dim sCol As Long: sCol = sws.Columns(sfCol).Offset(, dDay - 1).Column
    
    Dim sUpper As Long: sUpper = UBound(sRows)
    Dim n As Long
    For n = 0 To sUpper
        dws.Range(dAddresses(n)).Value = sws.Cells(sRows(n), sCol).Value
    Next n

End Sub
  • You can automate the previous with the following.

Sheet Module e.g. Sheet1 (List1)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const dMonthAddress As String = "V5"
    Const dDayAddress As String = "V6"

    Dim rg As Range: Set rg = Union(Range(dMonthAddress), Range(dDayAddress))
    If Not Intersect(Target, rg) Is Nothing Then
        ImportData
    End If

End Sub
  • Now when you change the values in V5 or V6, the destination worksheet is automatically updated.

Upvotes: 1

Wils Mils
Wils Mils

Reputation: 633

This is my take on this question:

Sub TEST()
    Dim intDay, intMonth As Integer
    Dim d As Integer
    intDay = CInt(Range("V6").Value)
    intMonth = CInt(Range("V5").Value)
    
    ' get the abbreviated month name
    txtMonth = MonthName(intMonth, True)
    
    ' it seems that this is the output template
    Set shtList = ThisWorkbook.Worksheets("List1")
    
    ' make sure that sheet of month name exists
    Set shtMonth = ThisWorkbook.Worksheets(txtMonth)
        
    d = 2 + intDay     ' column index; e.g. d + Day = 2 + 1 = "C", 2 + 2 = "D"
    
    With shtList
        .Range("I16").Value = shtMonth.Cells(10, d).Value
        .Range("N6").Value = shtMonth.Cells(18, d).Value
        .Range("T5").Value = shtMonth.Cells(12, d).Value
        .Range("T6").Value = shtMonth.Cells(11, d).Value
        .Range("T7").Value = shtMonth.Cells(23, d).Value
        .Range("D6").Value = shtMonth.Cells(7, d).Value
        .Range("D7").Value = shtMonth.Cells(19, d).Value
        .Range("Z7").Value = shtMonth.Cells(3, d).Value
        .Range("Y7").Value = shtMonth.Cells(16, d).Value
        .Range("Z6").Value = shtMonth.Cells(4, d).Value
        .Range("Y6").Value = shtMonth.Cells(17, d).Value
        .Range("N7").Value = shtMonth.Cells(5, d).Value
        .Range("M16").Value = shtMonth.Cells(2, d).Value
        .Range("D16").Value = shtMonth.Cells(16, d).Value
        .Range("Y9").Value = shtMonth.Cells(15, d).Value
        .Range("N11").Value = shtMonth.Cells(9, d).Value
        .Range("Z8").Value = shtMonth.Cells(8, d).Value
        .Range("Y8").Value = shtMonth.Cells(21, d).Value
    End With
    
End Sub

Run this every change in day or change in month. Sheets based on month should exist. No error handling was considered. No need to repeat codes.

Upvotes: 1

Christofer Weber
Christofer Weber

Reputation: 1474

To illustrate my comment:

   Sub TEST()
        Dim Day As Long, Month As Long
        Day = Range("V6").Value
        Month = Range("V5").Value ' Not sure what you are doing with this one?
        Worksheets("List1").Range("I16").Value = Worksheets("Jan").Cells(10, Day + 2).Value
        Worksheets("List1").Range("N6").Value = Worksheets("Jan").Cells(18, Day + 2).Value
        Worksheets("List1").Range("T5").Value = Worksheets("Jan").Cells(12, Day + 2).Value
        Worksheets("List1").Range("T6").Value = Worksheets("Jan").Cells(11, Day + 2).Value
        Worksheets("List1").Range("T7").Value = Worksheets("Jan").Cells(23, Day + 2).Value
        Worksheets("List1").Range("D6").Value = Worksheets("Jan").Cells(7, Day + 2).Value
        Worksheets("List1").Range("D7").Value = Worksheets("Jan").Cells(19, Day + 2).Value
        Worksheets("List1").Range("Z7").Value = Worksheets("Jan").Cells(3, Day + 2).Value
        Worksheets("List1").Range("Y7").Value = Worksheets("Jan").Cells(16, Day + 2).Value
        Worksheets("List1").Range("Z6").Value = Worksheets("Jan").Cells(4, Day + 2).Value
        Worksheets("List1").Range("Y6").Value = Worksheets("Jan").Cells(17, Day + 2).Value
        Worksheets("List1").Range("N7").Value = Worksheets("Jan").Cells(5, Day + 2).Value
        Worksheets("List1").Range("M16").Value = Worksheets("Jan").Cells(2, Day + 2).Value
        Worksheets("List1").Range("D16").Value = Worksheets("Jan").Cells(16, Day + 2).Value
        Worksheets("List1").Range("Y9").Value = Worksheets("Jan").Cells(15, Day + 2).Value
        Worksheets("List1").Range("N11").Value = Worksheets("Jan").Cells(9, Day + 2).Value
        Worksheets("List1").Range("Z8").Value = Worksheets("Jan").Cells(8, Day + 2).Value
        Worksheets("List1").Range("Y8").Value = Worksheets("Jan").Cells(21, Day + 2).Value
    End Sub

But yes, you can also put the data in arrays and such as well.
Hard to see much of a pattern here to short it down without understanding the data better.

The same idea can be applied to the month value if it's just to refer to another sheet, and if these sheets are in order. Like if "Jan" is sheet 2, and "Feb" is sheet 3 and so on:

 Worksheets("List1").Range("I16").Value = Worksheets(Month + 1).Cells(10, Day + 2).Value

Upvotes: 0

Related Questions