Hi,
I am having difficulty with the following data sheets and VBA code i was wondering if anyone could else
Essentially what i want to do
worksheet 1 - there is variable dates starting from E - BC
Worksheet 1 -
task items start in range B4 to maximum row 200
Column C is the number of times that the task needs to be copied for each date in the row starting from column E
The rows columns will vary per individual row could be 12 dates or 52 dates per row
there will be blank rows of data will need to skip row and check for next row of data
What I want to do
Work sheet 2 starting range B4 Find last row of data in table and copy each task item for each date in row and create duplicates based on the number in Column 3 on worksheet 1
only the task item and the dates should be copied from worksheet 1
Macro code:
I have the following two codes but i am having difficulty combining the different elements and also including for it to check the data has not already been copied to avoid duplicates and also only copy the data from Column B and the dates only
Code 1:
This code creates the tasks and splits the dates and creates new row for each date but pulls the data to a new worksheet I want the data to be pulled to specified worksheet 2 and also copies the columns in between the data i only want B and the dates from each row as above
Sub
rng As Range, r&, c&, rc&, cc&
Dim i&, ii&, sh As Worksheet
Set rng = Range("B4").CurrentRegion
rc = rng.Rows.Count
cc = rng.Columns.Count
Set sh = Worksheets.Add
i = 1
For r = 4 To rc
For c = 4 To cc
If rng.Cells(r, c) <> "" Then
For ii = 1 To 2
sh.Cells(i, ii) = rng.Cells(r, ii)
Next ii
rng.Cells(r, c).Copy
With sh.Cells(i, 3)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
i = i + 1
End If
Next c
Next r
End Sub
Code 2
This code creates a copy of the data based on the variance of the number and copies it into the same worksheet in specific cells but I do not know how to combine The codes
Sub copy()
Dim i As Double
Dim j As Double
Dim z As Double
Dim w As Double
For i = 2 To 1000
j = Cells(i, 2).Value
For z = 2 To j + 1
Cells(z + w, 4).Value = Cells(i, 1).Value
Cells(z + w, 5).Value = Cells(i, 2).Value
Next z
w = w + z - 2
Next i
End Sub
I am having difficulty with the following data sheets and VBA code i was wondering if anyone could else
Essentially what i want to do
worksheet 1 - there is variable dates starting from E - BC
Worksheet 1 -
task items start in range B4 to maximum row 200
Column C is the number of times that the task needs to be copied for each date in the row starting from column E
The rows columns will vary per individual row could be 12 dates or 52 dates per row
there will be blank rows of data will need to skip row and check for next row of data
Headers (A) | Data (b) | Number (C) | Day (D) | Date 1 (E) | Date 2 etc > up to variable 12/52 |
Header 1 | Apple | 1 | 1 | 01/01/2024 | 01/02/2024 |
Header 1 | Banana | 2 | 4 | 04/01/2024 | 04/02/2024 |
Header 1 | Orange | 3 | 3 | 03/01/2024 | 03/02/2024 |
Header 1 | |||||
Headers 1 | |||||
Headers 1 | |||||
Headers 2 | Pear | 2 | 1 | 01/01/2024 | 01/02/2024 |
Headers 2 | Tomato | 3 | 2 | 02/01/2024 | 02/02/2024 |
What I want to do
- For every cell data in B from range B4 to last row
- check if the data has already been copied or if its been changes match it to worksheet 2 data so duplicates of the task item and date are not copied over twice
- Create a new row on worksheet two for every date across row in worksheet 1 for each individual row and copy the data across so that each date in the row has its own individual row with the corresponding data from B for each date create duplicates of the individual task item and individual date on each row onto worksheet 2 depending on the number variance in column 3 on worksheet 1
- If it comes across a blank row
- Only copying data from B and the dates from the rows to worksheet 2
- When new dates and data are added to worksheet 1 and the code is re-run I want it to check if the task has already been copied so it wont create duplicates of the already created task list
- If the dates are changed on worksheet 1 for any of-
- the tasks I want the worksheet 2 dates to update when the code is refreshed
Work sheet 2 starting range B4 Find last row of data in table and copy each task item for each date in row and create duplicates based on the number in Column 3 on worksheet 1
only the task item and the dates should be copied from worksheet 1
Task No. | Task | Date |
Apple | 01/01/2024 | |
Apple | 01/02/2024 | |
Banana | 01/01/2024 | |
Banana | 01/01/2024 | |
Banana | 01/02/2024 | |
Banana | 01/02/2024 | |
Pear | 01/01/2024 | |
Pear | 01/01/2024 | |
Pear | 01/02/2024 | |
Pear | 01/02/2024 | |
Tomato | 01/01/2024 | |
Tomato | 01/01/2024 | |
Tomato | 01/01/2024 | |
Tomato | 01/02/2024 | |
Macro code:
I have the following two codes but i am having difficulty combining the different elements and also including for it to check the data has not already been copied to avoid duplicates and also only copy the data from Column B and the dates only
Code 1:
This code creates the tasks and splits the dates and creates new row for each date but pulls the data to a new worksheet I want the data to be pulled to specified worksheet 2 and also copies the columns in between the data i only want B and the dates from each row as above
Sub
rng As Range, r&, c&, rc&, cc&
Dim i&, ii&, sh As Worksheet
Set rng = Range("B4").CurrentRegion
rc = rng.Rows.Count
cc = rng.Columns.Count
Set sh = Worksheets.Add
i = 1
For r = 4 To rc
For c = 4 To cc
If rng.Cells(r, c) <> "" Then
For ii = 1 To 2
sh.Cells(i, ii) = rng.Cells(r, ii)
Next ii
rng.Cells(r, c).Copy
With sh.Cells(i, 3)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
i = i + 1
End If
Next c
Next r
End Sub
Code 2
This code creates a copy of the data based on the variance of the number and copies it into the same worksheet in specific cells but I do not know how to combine The codes
Sub copy()
Dim i As Double
Dim j As Double
Dim z As Double
Dim w As Double
For i = 2 To 1000
j = Cells(i, 2).Value
For z = 2 To j + 1
Cells(z + w, 4).Value = Cells(i, 1).Value
Cells(z + w, 5).Value = Cells(i, 2).Value
Next z
w = w + z - 2
Next i
End Sub