Saturday, November 16, 2019

excel - Keep Reference Cell in New Sheet



I am basically trying to get actions taken on one sheet to be mirrored on another sheet. Copy and paste A1 to B1 on Sheet1? Copy and paste A1 to B1 on Sheet2. The problem is, it always needs to be in reference to the active cell and I can't figure out how to save the address of the active cell in a usable format.



Here is the scenario I want to accomplish, in pretty plain English:




  1. Where Cell is ActiveCell on Sheet1, insert row below Cell's row on Sheet2 (e.g., if Sheet1!A1 is active cell, insert row below Sheet2 row 1).


  2. On Sheet1: Copy ActiveCell.Row and insert below ActiveCell.Row.


  3. On Sheet2: Perform same, but on corresponding rows on Sheet2, except I want to paste it in my newly inserted row from Step 1. So, if I copied Sheet1 Row 1 and inserted it below Row 1 in Step 2, I want to copy Sheet2 Row 1 and PASTE it in the new row from Step 1.



  4. Returning to Sheet1, use InputBox to get a value from the user, insert that value in Range("D" & (ActiveCell.Row))




I have this all working, except the Sheet2 part, and it breaks formulas if I can't get that line in before I copy/insert on Sheet1. I have gone through the steps manually and it all works if I can get it coded.



Sub Button18_Click()



Dim Row_Source As Range
Dim WS As Worksheet, WS2 As Worksheet
Dim Day_Num As String

Dim Day_Dest As Range
Dim PRL As String
Dim Address As String
Dim RowNum As Long

Dim Cell As Range
Set Cell = ActiveCell ' just in case you'll decide to give-up on the "bad practice" of using ActiveCell
RowNum = Cell.Row

Set WS = ThisWorkbook.Sheets("Protocols")

Set WS2 = ThisWorkbook.Sheets("Formulas")

With WS
PRL = .Range("B" & RowNum).Value

Day_Num = InputBox("Please enter a day number to add to: " & PRL, "Add New Day")
If Day_Num <> "" Then
Set Row_Source = .Rows(RowNum)
End If
End With


With WS2
If Day_Num <> "" Then
Row_Source.Offset(1).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
End With

With WS
If Day_Num <> "" Then

Row_Source.Copy

Row_Source.Offset(1).Insert Shift:=xlDown
Application.CutCopyMode = False

.Range("D" & RowNum + 1).Value = Day_Num
End If
End With

With WS2

If Day_Num <> "" Then
Set Row_Source = .Rows(RowNum)
Row_Source.Copy

Row_Source.Offset(1).Select
Row_Source.PasteSpecial
Application.CutCopyMode = False
End If
End With



End Sub


Answer



This is the code that did it. I couldn't have completed this without Shai Rado, where most of the credit should go. This works exactly to specification:



Sub Button18_Click()

Dim Row_Source As Range
Dim WS As Worksheet, WS2 As Worksheet
Dim Day_Num As String

Dim Day_Dest As Range
Dim PRL As String
Dim RowNum As Long
Dim Cell As Range

Set Cell = ActiveCell ' just in case you'll decide to give-up on the "bad practice" of using ActiveCell
RowNum = Cell.Row

Set WS = ThisWorkbook.Sheets("Protocols")
Set WS2 = ThisWorkbook.Sheets("Formulas")


With WS
PRL = .Range("B" & RowNum).Value

Day_Num = InputBox("Please enter a day number to add to: " & PRL, "Add New Day")
If Day_Num <> "" Then
Set Row_Source = .Rows(RowNum)
End If
End With


With WS2
If Day_Num <> "" Then
Set Row_Source = .Rows(RowNum)
Row_Source.Offset(1).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
End With

With WS
If Day_Num <> "" Then

Set Row_Source = .Rows(RowNum)
Row_Source.Copy

Row_Source.Offset(1).Insert Shift:=xlDown
Application.CutCopyMode = False

.Range("D" & RowNum + 1).Value = Day_Num
End If
End With


With WS2
Set Row_Source = .Rows(RowNum)
Row_Source.Copy

Row_Source.Offset(1).PasteSpecial

Application.CutCopyMode = False
End With

End Sub


No comments:

Post a Comment

hard drive - Leaving bad sectors in unformatted partition?

Laptop was acting really weird, and copy and seek times were really slow, so I decided to scan the hard drive surface. I have a couple hundr...