Reputation: 15
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
Reputation: 54817
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
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
V5
or V6
, the destination worksheet is automatically updated.Upvotes: 1
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
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