Copy cell range to another sheet into a specific column based on a criteria

[mst3kr]

Hello all.

I have a file updated each day with two tabs: Sheet 1 has data for daily performance for some plants I am tracking.

Date	1/17/22
Plant 1	8.4%
Plant 2	2.6%
Plant 3	3.7%
Plant 4	12.4%
Plant 5	6.0%

The second sheet has a recap that is needed to be captured each day and kept for historical & graphing purposes.

1-Jan

2-Jan

3-Jan

4-Jan

5-Jan

6-Jan

7-Jan

8-Jan

9-Jan

10-Jan

11-Jan

12-Jan

13-Jan

14-Jan

15-Jan

16-Jan

17-Jan

18-Jan

19-Jan

20-Jan

21-Jan

22-Jan

23-Jan

24-Jan

25-Jan

26-Jan

27-Jan

28-Jan

29-Jan

30-Jan

31-Jan

Plant 1

8.40%

Plant 2

2.60%

Plant 3

3.70%

Plant 4

12.40%

Plant 5

6.00%

What I'm trying to do is create some VBA that, upon saving, would take the percentage values from Sheet 1 and automatically copy & paste those values in Sheet 2 into the corresponding column based on the date in Sheet 1.

I already have the VBA to save a macro upon saving but I haven't been able to figure out how to copy & paste with the condition on the date. I could copy & paste the values manually each day, but in case I forget, I can make the VBA upon saving make sure this is done for me.

Any help would be appreciated!

Thanks!
-Greg (mst3kr)

 

[BSALV]

i used 3 named ranges (see below)

Sub Recapture()
     Set c1 = Sheets("sheet1").Range("MySource")                'range in sheet1 with your new data
     Set c2 = Sheets("sheet2").Range("MyDates")                 'range in sheet2 with your dates
     Set c3 = Sheets("sheet2").Range("MyPlants")                'range in sheet2 with your plants

     k = Application.Match(c1.Cells(1, 2).Value2, c2.Value2, 0)     'find the relative position of your date in that range of dates (use value2, to be independent of numberformat) !
     If Not IsNumeric(k) Then MsgBox "date isn't found", vbCritical: Exit Sub     'that position isn't found = end of story

     For i = 2 To c1.Rows.Count                                 'loop through the data of the different plants
          r = Application.Match(c1.Cells(i, 1), c3.Value, 0)    'find the relative position of your plant in the range of plants
          If Not IsNumeric(r) Then                              'position isn't found
               MsgBox "row for " & c1.Cells(i, 1).Value & " not found"     'msgbox to tell
          Else
               Sheets("sheet2").Cells(c3.Row + r - 1, c2.Column + k - 1).Value = c1.Cells(i, 2)     'write your value to that cell in sheet2 with that rownumber and columnnumber
          End If
     Next
End Sub

Map1
	B	C
11	Date	01/17/22
12	Plant 1	8,40%
13	Plant 2	2,60%
14	Plant 3	3,70%
15	Plant 4	12,40%
16	Plant 5	6,00%
Sheet1

Map1
	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ
13		01/01/22	01/02/22	01/03/22	01/04/22	01/05/22	01/06/22	01/07/22	01/08/22	01/09/22	01/10/22	01/11/22	01/12/22	01/13/22	01/14/22	01/15/22	01/16/22	01/17/22	01/18/22	01/19/22	01/20/22	01/21/22	01/22/22	01/23/22	01/24/22	01/25/22	01/26/22	01/27/22	01/28/22	01/29/22	01/30/22	01/31/22
14	Plant 1																	0,084
15	Plant 2																	0,026
16	Plant 3																	0,037
17	Plant 4																	0,124
sheet2

defined names used

Map1
	F	G
13	MyDates	=sheet2!$F$13:$AL$13
14	MyPlants	=sheet2!$E$14:$E$18
15	MySource	=Sheet1!$B$11:$C$16
Sheet1

 

[Micron]

amateurish no doubt, but since I just finished playing I might as well post it.

Sub InsertValues()
Dim strDate As String
Dim i As Integer

Worksheets("Sheet9").Select
strDate = Range("B1")

With Worksheets("Sheet10")
   .Activate
   For i = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
      If .Cells(1, i) = strDate Then
         Worksheets("Sheet9").Range("B2:B6").Copy .Cells(2, i)
         Exit For
      End If
   Next
End With

End Sub

Assumes data is located and needs to be copied as was shown.

 

[mst3kr]

Thanks BSLAV! Your code worked perfectly!

I also want to add that, as a bit of a VBA noob, you explaining the why's & how's behind your code really makes it easier to understand the workings of the code, and helps me learn just that little bit more so I can get to be more independent in writing code. Very much appreciated!

 

[Micron]

You will need a copy of the code, or a named range for every month sheet? Not all months have 31 days.

 

[mst3kr]

Hi Micron. No. The way I ultimately need to report performance is by month. So, each file will be its own month. So, I won't need to keep multiple tabs for more than one month within the same file. Thanks!