'Paste copied values in row where date was found
I have column A with dates. I have data in range o4:z4 that is manipulated by pivot with Timeline.
I need to paste that data from o4:z4 to column B2:M2. The row number is indicated as example.
I need to paste that data to the row where is yesterday's date Example 12/27/2021.
Solution 1:[1]
An alternative without using evaluate
Option Explicit
Sub Datos_nustatymas()
Dim wb As Workbook, ws As Worksheet
Dim LastRow As Long, i As Long, r As Long
Dim dt As Date, dtLast As Date, newdays As Long
Set wb = ThisWorkbook
wb.RefreshAll ' Refresh Pivot '
Application.ScreenUpdating = False
Set ws = wb.Sheets("Report")
With ws
' find end of existing data in B
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
' calc number of days to yesterday
dtLast = .Range("A" & LastRow).Value2
newdays = Date - 1 - dtLast
If newdays < 1 Then
MsgBox "No days to add", vbExclamation
Exit Sub
Else
' extend column A to yesterday
With .Range("A" & LastRow + 1).Resize(newdays)
.Formula = "=R[-1]C+1"
.Value = .Value
End With
End If
'update column B
For i = 1 To newdays
r = LastRow + i
dt = .Cells(r, "A")
' this code selects a timeline date
.SlicerCaches("NativeTimeline_Value_Date").TimelineState. _
SetFilterDateRange dt, dt
.SlicerCaches("NativeTimeline_Good_Date").TimelineState. _
SetFilterDateRange dt, dt
' Copy/Paste details from Pivot to celected cells'
.Range("O4:Z4").Copy
.Cells(r, "B").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next
End With
Application.ScreenUpdating = True
MsgBox newdays & " days added", vbInformation
End Sub
Solution 2:[2]
Thanks for the help @CDP1802
Got the answer in another thread
Sub Datos_nustatymas()
Dim lastrow_blank As Long
Dim lastrow_blankA As Long
Dim lastrow_blankselection As Long
Dim a As Long
Sheets("Report").Select ' Select sheet '
ThisWorkbook.RefreshAll ' Refresh Pivot '
Data = Date - 1 ' Yesterdays date '
lastrow_blankA = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1 ' first blank cell in column A '
lastrow_blank = Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row + 1 ' first blank cell in column B '
a = Range("A2").Value
Range("A3:A" & CLng(Date - a + 1)).Value = Evaluate("Row(" & a + 1 & ":" & CLng(Date) & ")") ' Paste date's until yesterday in column A '
Do Until IsEmpty(Cells(lastrow_blank, 1))
lastrow_blankselection = CDate(Cells(lastrow_blank, 1).Value) ' Value selection of the last low in column A '
If Cells(lastrow_blank, 1) = "" Then ' If first cell in column B is empty then '
MsgBox "Info" ' Message if cell is empty '
Exit Sub
Else
ActiveWorkbook.SlicerCaches("NativeTimeline_Value_Date").TimelineState. _
SetFilterDateRange lastrow_blankselection, lastrow_blankselection ' this code selects a timeline date '
ActiveWorkbook.SlicerCaches("NativeTimeline_Good_Date").TimelineState. _
SetFilterDateRange lastrow_blankselection, lastrow_blankselection ' this code selects a timeline date '
Sheets("Report").Range("O4:Z4").Copy ' Copy cells that returns details from Pivot '
Cells(lastrow_blank, 2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False ' Paste details from Pivot to celected cells'
' when the code is launched it loops first time correctly and then after the paste code it gets stuck i think because it does nothing'
' After I cancel the code paste code get highlited in yellow '
End If
lastrow_blank = lastrow_blank + 1
Loop
End Sub
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|---|
| Solution 1 | CDP1802 |
| Solution 2 | Mindaugas Vilimas |
