Store a Row Location Before Pasting and then Paste to that Location.

[theteerex]

Hi All,

I am trying to copy a cell from 1 sheet and paste it in another sheet After pasting a template.
The problem is, I am using the paste after last row command but this mean that if I ever change the template dimensions, I would have to change the code.
So I am trying to solve this problem by defining what the last row is prior to pasting and then pasting to the next row, as opposed to finding the new last row, and then counting backwards, which was my original solution.

My code:

[COLOR=#0000ff]Sub[/COLOR] FindProj()
[COLOR=#0000ff]Dim[/COLOR] Lastrow As [COLOR=#0000ff]Long[/COLOR]
[COLOR=#0000ff]Dim[/COLOR] Newproj As [COLOR=#0000ff]Long[/COLOR]
Lastrow = Sheets("Historical").Cells(Rows.Count, "B").End(xlUp).Row
Newproj = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Offset(1)
AddProj [COLOR=#008000]'This copies the template and pastes it to the first empty row[/COLOR]
Sheets("Historical").Cells(Lastrow, "B").Copy Sheets("Data").Range(Newproj, "A")
[COLOR=#0000ff]End Sub[/COLOR]

Any help is appreciated.

 

[Joe4]

So where do you propose on storing/defining this value?

You could do it in VBA, but that means that you will still need to update VBA if your template changes.
Sometimes, I put values like that at the very top of my VBA code, so if anyone needs to change them, they are easy to identify and update.

You could also store it in some cell on some sheet somewhere and have your VBA code get it from there.
Or, if there is some methodology to dynamically figure it out, please explain what that logic is.

 

[theteerex]

So right now, here is how my code works:

Sub Worksheet_Calculate()
'Detects when there is a change in the number of rows in "Historical".


Dim X As Range
'Defines X as variable
Set X = LastCell
    If Sheet5.Range("A" & Rows.Count).Value < X.Value Then 'Finds last row and looks for change from X
        X.Value = Me.Range("A" & Rows.Count).Value
        FindProj 'Runs FindProj Module
    End If
End Sub

Sub FindProj()
Dim Lastrow As Long
Dim Newproj As Long
Lastrow = Sheets("Historical").Cells(Rows.Count, "B").End(xlUp).Row
Newproj = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Offset(1)
AddProj 'This copies the template and pastes it to the first empty row
Sheets("Historical").Cells(Lastrow, "B").Copy Sheets("Data").Range(Newproj, "A")
End Sub

Function LastCell() As Range
'Looks for the last cell in Table 5 of Historical.
    With Sheet5
        Set LastCell = .Cells(Rows.Count, 1).End(xlUp)
    End With
End Function


Sub AddProj()
'Copies the master template and Pastes it at the bottom of the data range
Sheet1.Range("Master").Copy Sheet1.Range("C" & Rows.Count).End(xlUp).Offset(1)
'FindProj


End Sub

So you can see that my cell pastes the value from Historical in Data After it pastes my template.
This means my template always has to be the same size.
If I add columns in my Historical worksheet, my template automatically increases in size.
When this happens, my value from Historical that is pasted in Data is pasted in the wrong location.

Initially, I thought I could simply rearrange when events happen, but it doesn't work out.
I need to make it so, I always paste on the row below the last row in Data prior to the template being pasted.
Except that if I pasted before the template is pasted, the template would overwrite the cell.

 

[Fluff]

What if you swap these 2 lines round

Newproj = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Offset(1)
AddProj 'This copies the template and pastes it to the first empty row

 

[theteerex]

It just broke my spreadsheet.
It seems that when you swap the two, it gets stuck in a loop and keeps pasting the template.
The code that I use that currently works with my current template is slightly different from above:

[COLOR=#0000ff]Sub[/COLOR] Worksheet_Calculate()
[COLOR=#008000]'Detects when new row is added[/COLOR]

Dim X As Range
Set X = LastCell
    If Sheet5.Range("A" & Rows.Count).Value < X.Value Then
        X.Value = Me.Range("A" & Rows.Count).Value
        AddProj
    End If

[COLOR=#0000ff]End Sub[/COLOR]

[COLOR=#0000ff]Function[/COLOR] LastCell() As Range [COLOR=#008000]'Defines the value of the last cell[/COLOR]
    With Sheet5
        Set LastCell = .Cells(Rows.Count, 1).End(xlUp)
  [COLOR=#0000ff]  End With


End Function[/COLOR]


[COLOR=#0000ff]Sub[/COLOR] AddProj() [COLOR=#008000]'Adds new template to Data Worksheet[/COLOR]


Sheet1.Range("Master").Copy Sheet1.Range("C" & Rows.Count).End(xlUp).Offset(1)
FindProj


[COLOR=#0000ff]End Sub[/COLOR]



[COLOR=#0000ff]Sub[/COLOR] FindProj() [COLOR=#008000]'Finds project name in Historical Worksheet and pastes it in Data Worksheet[/COLOR]
Dim Lastrow As Long
Dim Newproj As Long
Lastrow = Sheets("Historical").Cells(Rows.Count, "B").End(xlUp).Row
Newproj = Sheets("Data").Cells(Rows.Count, "C").End(xlUp).Row
Sheets("Historical").Cells(Lastrow, "B").Copy Sheets("Data").Cells(Newproj - 30, "C")

[COLOR=#0000ff]End Sub[/COLOR]

 

[Fluff]

Do you have a value/formula in A1048576 (or A65536 on older files) on sheet5?

 

[theteerex]

No I do not

Do you have a value/formula in A1048576 (or A65536 on older files) on sheet5?

 

[Fluff]

In that case this line

Sheet5.Range("A" & Rows.Count).Value

will always be blank.
What are you trying to do?

 

[theteerex]

You need this function for context:

Function LastCell() As Range 'Defines the value of the last cell
    With Sheet5
        Set LastCell = .Cells(Rows.Count, 1).End(xlUp)
    End With
End Function

X = LastCell

When there is a difference between X and Sheet5.Range("A" & Rows.Count).Value, a new template is created on another sheet.
It's counting rows in a table so the next row is always blank until it isn't anymore right?

 

[Fluff]

In this part of the code

Sub Worksheet_Calculate()
'Detects when new row is added

Dim X As Range
Set X = LastCell
    If [COLOR=#ff0000]Sheet10.Range("A" & Rows.Count).Value[/COLOR] < X.Value Then
        X.Value = Sheet10.Range("A" & Rows.Count).Value
        AddProj
    End If

End Sub

The part in red will always be "empty".