copy paste link to user-input cell reference - excel

I make a lot of data entry mistakes and I am trying to come up with a way to verify my input. I copy values from cells to another, I figure it would be best if I linked to the cell directly and then had those cells automatically colored.
Here is my proposal:
Selection.Copy
Selection.Interior.ColorIndex = 37
Set rng = Application.InputBox("Cell reference", Type:=8)
Now I cannot figure out a way to paste the links to the input cell reference. It seems like by selecting a cell with the input box, the selection is lost.

So, you want to select a cell and change its contents based on another cell contents, right? You are creating a reference to the source cell by using the set statement. Now, you just have to use the .address property of your range to get a string value that represents the range reference in the language of the macro (See help for this property).
Option Explicit
Sub CopyingCellContents()
Dim rng As Range
Selection.Copy
Selection.Interior.ColorIndex = 37
Set rng = Application.InputBox("Cell reference", Type:=8)
Selection.Value = activesheet.range(rng.Address)
End Sub
A tip: ALWAYS set the Require Variable Declaration in your code.
Considering your further explanation and your own code, I tried to update yours.
Sub xxx
Dim rng As Range
Dim inp As Range
Dim Sh as worksheet 'Worksheet where your range is.
set Sh= workbooks("Name Of The Workbook").worksheets("Name Of The Worksheet")
Set inp = Selection
inp.Interior.ColorIndex = 37
Set rng = Application.InputBox("Copy to", Type:=8)
sh.activate
inp.Copy Destination:=rng, Link:=True
End sub
Change "Name Of The Workbook" and "Name Of The Worksheet" by the names of the workbook and and worksheet respectively where the ranges you want to manipulate are. Don't forget to use "".

I have reworked some code. Here it is :
Dim rng As Range
Dim inp As Range
Selection.Interior.ColorIndex = 37
Set inp = Selection
Set rng = Application.InputBox("Copy to", Type:=8)
inp.Copy
rng.Select
ActiveSheet.Paste Link:=True
It seems to work, thanks!

Related

Copy_Paste_Visible_Cells_Only

I have been trying to Copy the Filtered data and pasting the data on filtered cell but my code is not working.
I have data in Range Sheet2.Range("O2:O10000") and i filtered this range to Sheet2.Range("O173:O2400").
I want to copy the data from filtered cells Sheet2.Range("O173:O2400") then paste this data to visible cells on same Sheet2.Range("N173:N2400")
Please note there are multiple hidden rows in this range.
Any help will be appreciated
Sub Copy_Paste__Visible_Cells_Only()
Sheet2.Range("O173:O2400").SpecialCells(xlCellTypeVisible).Copy
Sheet2.Range("N173:N2400").SpecialCells(xlCellTypeVisible).Paste
End Sub
In this case, pasting won't work. As far as I know, you can't change the paste behaviour to only paste to visible cells.
When you select visible cells only, you get a collection of areas (you can think of them as a discontinuous set of ranges). Given you're just trying to move your visible data to the left, you can do it by looping through the areas and assigning their values to the same area in the previous column. Something like this:
Public Sub CopyVisible()
Dim a As Range
For Each a In Sheet1.Range("O4:O17").SpecialCells(xlCellTypeVisible).Areas
a.Offset(0, -1).Value = a.Value
Next
End Sub
The .Offset(0,-1) is signalling that you wish the values to be moved one column to the left
You can see from this example, when I filter on "a" in column O and run the macro, only the "a" values are moved to column N.
I would use a generic sub copyVisibleCellsToOtherColumn to which you pass the source-range and the target-start range.
Advantage you can re-use it for different scenarios.
Sub test_CopyVisibleCells()
Dim rgSource As Range
Set rgSource = sheet2.Range("O173:O2400")
Dim rgTarget As Range
Set rgTarget = sheet2.Range("N173:02400")
copyVisibleCells rgSource, rgTarget
End Sub
'this ist the generic sub
Public Sub copyVisibleCellsToOtherColumn(rgSource As Range, rgTarget As Range)
Dim c As Range, a As Range
For Each a In rgSource.Areas
'this will return the visible cells within rgsource
For Each c In a.Cells
rgTarget.Rows(c.Row).Value = c.Value
Next
Next
End Sub
I found code from somewhere which able to copy visible cells and paste into visible cells. For easy usage, I manually assign a shortcut ctrl+shift+C to call the macro.
Public Sub Copy_Range_Paste_Into_Visible_Cells()
'Sub Copy_Range_Paste_Into_Visible_Cells()
Dim rngSource As Range, rngDestination As Range, cell As Range, cc As Long, i As Long
On Error Resume Next
Application.DisplayAlerts = False
Set rngSource = Application.InputBox("Select the filtered range to copy. ", "Select Filtered Cells", Type:=8)
If rngSource Is Nothing Then Application.DisplayAlerts = True: Exit Sub 'User canceled
Set rngDestination = Application.InputBox("Select the destination cell to paste to. ", "Select Paste Destination", Type:=8)
If rngDestination Is Nothing Then Application.DisplayAlerts = True: Exit Sub 'User canceled
On Error GoTo 0
Application.DisplayAlerts = True
cc = rngSource.Columns.Count
For Each cell In rngSource.Columns(1).SpecialCells(xlCellTypeVisible)
Do Until Not rngDestination(1).Offset(i).EntireRow.Hidden
i = i + 1
Loop
rngDestination(1).Offset(i).Resize(1, cc).Value = cell.Resize(1, cc).Value
i = i + 1
Next
End Sub

Sum of range in a specific cell with predefined range in vba

I have a selected range that I defined as my range. I want to get the Sum of this selection in a specific cell.
The makro shall find "x", select the cell below and put in "Sum" + the range I defined in "myrange"
Sub more_twelve_months()
Dim myrange As Range
Set myrange = Range(Range("F5"), Range("F5").End(xlToRight))
Set more_twelve_months = Range("A1:ZZ10000").Find("x")
more_twelve_months.Select
FormularCell = ActiveCell.Offset(1, 0).Select
Selection.Resize(Selection.Rows.Count, _
Selection.Columns.Count).Select
ActiveCell.Sum (myrange)
I tried several ways to get the sum, ActiveCell.Sum (myrange) is just the last thing I tried.
Any ideas how I can solve this?
Is this what you want?
You should avoid using Select as far as possible.
Sub more_twelve_months()
Dim myrange As Range
Dim more_twelve_months As Range 'declare your variables
Set myrange = Range(Range("F5"), Range("F5").End(xlToRight))
Set more_twelve_months = Range("A1:ZZ10000").Find("x")
If Not more_twelve_months Is Nothing Then 'check you've found something to avoid errors
more_twelve_months.Offset(1).Value = Application.Sum(myrange)
End If
End Sub

Copying different ranges of cell data from one sheet to another

I need to be able to copy different ranges of cells from one worksheet to another. For example A1:A4, C3:C7, D3:D6. I need the code to do the following:
Copy different data from those cells in the first worksheet (worksheet1) and paste them onto the same line but transposed on the second worksheet (worksheet2). I don't need to keep the original formatting.
When pasting the data I need it to find the last row and paste it below that row.
I can write a code which will do most of that but I only know how to get the code to do it for one cell range e.g. A1:A4.
Any help would be greatly appreciated.
OK, technically SO isn't a code-writing service but I use a code that does basically just that, so you might as well have it;
Sub CopyTransposeRange()
Dim shtCopy As Worksheet
Dim shtPaste As Worksheet
Dim rngCopy As Range
Set shtCopy = Sheets("Sheet1").Activate
Set shtPaste = Sheets("Sheet2")
Set rngCopy = Range("A1:A36")
'Put whatever's necessary in here to select the correct range
shtCopy.rngCopy.Copy
shtPaste.Activate
shtPaste.Range(Cells(shtPaste.UsedRange.Rows.Count + 1, 1), Cells(shtPaste.UsedRange.Rows.Count + 1, rngCopy.Rows.Count)).PasteSpecial _
xlPasteAll, xlPasteSpecialOperationNone, False, True
End Sub
Yes, I know activating sheets isn't best practice, but works for me ¯_(ツ)_/¯
hope it helps.
Try this code, please.
It will copy your selected range and transpose it in the roe 2 of second sheet:
Sub testCopyTransposedRanges()
Dim sh2 As Worksheet, inpRng As Range, lastCol As Long, arrTr As Variant
Set inpRng = Application.InputBox("Select range to be copied and transposed:", _
"Range Selection", Selection.Address, Type:=8)
If inpRng Is Nothing Then Exit Sub
arrTr = inpRng.value
If IsEmpty(arrTr) Then Exit Sub
Set sh2 = Worksheets("worksheet2") ' use here your sheet name!!!
lastCol = sh2.Cells(2, Cells.Columns.Count).End(xlToLeft).Column + 1
sh2.Cells(2, lastCol).Resize(, UBound(arrTr)).value = WorksheetFunction.Transpose(arrTr)
End Sub
It must be 'filterred' for 'Cancel', multi column selection etc. But this will be done only if such a solution matches your need. Otherwise, you must present the logic based on what to create an algorithm to automatically select the necessary ranges.

VBA code for copying and pasting a value from a specific cell that is changing as the macro runs

I'll try (as best I can) to explain the code I'm using
Essentially I have an excel which outputs a value to cell W151 based on a calculation that depends on cells in the range Q149:Q182.
The first step is to reset all the values in the range Q149:Q182 to their base values by copying and pasting from cells S149:S182.
Based on the base values for the formula, I copy and paste the value outputted to W151 into W99
Next, I change the value in Q149 to "2". This updates the calculation and hence the value in cell W151 which I then copy and paste into W100
Then I change Q150 to "2" and again copy the value from W151, this time into W101 and so on and so forth
My question is, is there a way of setting the cells that i'm changing as an array (picked by the user through a prompt), the output cell W151 as a variable (picked by the user through a prompt) and the destination for the copied values (i.e. currently cells W99:W101) as an array also picked by the user via a prompt. If not is there any way you can think of that might automated this process?
I appreciate that I might have done a poor job explaining what I'm trying to do so please feel free to ask for clarifications (although I warn you my VBA knowledge is very limited)
Many Thanks,
Thomas
Sub Example()
Range("S149:S182").Select
Selection.Copy
Range("Q149").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("W151").Select
Selection.Copy
Range("W99").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("Q149").Select
ActiveCell.FormulaR1C1 = "2"
Range("W151").Select
Selection.Copy
Range("W100").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("Q150").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "2"
Range("W151").Select
Selection.Copy
Range("W101").Select
Selection.PasteSpecial Paste:=xlPasteValues
End Sub
Not quite the way I was hoping to do it as this still relies on putting values on the worksheet.
There's one step missing that I didn't understand:
Based on the base values for the formula, I copy and paste the value
outputted to W151 into W99
This is done before you turn the first value to 2. So is it a case of the base average goes into W99, then you change the first value to 2 and that goes into W100. i.e. If you start with 34 values in column Q you'll end with 35 values copied to column W?
Sub Test()
Dim CopyRng As Range
Dim rCell As Range
With ThisWorkbook.Worksheets("Sheet1")
Set CopyRng = .Range("Q149:Q182")
CopyRng.Value = .Range("S149:S182").Value
.Range("W99").Value = .Range("W151").Value
For Each rCell In CopyRng
rCell.Value = 2
'Q149 Offset by -49 rows and +6 columns = cell W100.
rCell.Offset(-49, 6).Value = .Range("W151").Value
Next rCell
End With
End Sub
Edit:
To ask the user to make the selections you could use the following method.
One problem that hasn't been addressed in this code is if the user presses Cancel, but hopefully the link will point you in the right direction - I liked the answer given by #DirkReichel.
Sub Test()
Dim CopyRng As Range
Dim rCalculation As Range
Dim rDestination As Range
Dim rCell As Range
'Creating the base values is a manual operation now.
'CopyRng.Value = Sheet1.Range("S149:S182").Value
Set CopyRng = Application.InputBox("Select range to be evaluated.", Type:=8) 'Q149:Q182
'Calculation must be a single cell.
Do
Set rCalculation = Application.InputBox("Select cell containing calculation.", Type:=8) 'W151
Loop While rCalculation.Cells.Count <> 1
'First cell in destination must be a single cell.
Do
Set rDestination = Application.InputBox("Select first cell to be pasted to.", Type:=8) 'W99
Loop While rDestination.Cells.Count <> 1
rDestination.Value = rCalculation.Value
For Each rCell In CopyRng
rCell.Value = 2
rDestination.Offset(rCell.Row - CopyRng.Row + 1).Value = rCalculation.Value
Next rCell
End Sub
You have lot of unnecessary things in your code simply use inputbox to get the range and use it as required.
Sub Example()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Application.InputBox("Select range1", Type:=8)
Set rng2 = Application.InputBox("Select range2", Type:=8)
With Sheets("Sheet1")
.Range("Q149:Q182").Value = rng1.Value
.Range("W99").Value = rng2.Value
.Range("Q149").FormulaR1C1 = "2"
.Range("W100").Value = rng2.Value
.Range("Q150").FormulaR1C1 = "2"
.Range("W101").Value = rng2.Value
End With
End Sub
#Thomas first of all welcome!
Make the necessary changes (Sheet name or ranges) and try:
Sub Example()
With (Sheet1) '<= Change Sheet Name if needed
.Range("S149:S182").Copy .Range("Q149")
.Range("W151").Copy .Range("W99")
.Range("W151").Copy .Range("W100")
.Range("W151").Copy .Range("W101")
.Range("Q149").value="2"
.Range("Q150").value = "2"
End With
End Sub

In reference to "Copy a row in excel if it matches a specific criteria into a new worksheet"

In reference to: Copy a row in excel if it matches a specific criteria into a new worksheet
I attempted applying the above hyperlink code to the needs of my own workbook. The only notable differences are: Object names, My data begins in "A2" instead of "A1", and my data is being copied to "L" column in a new worksheet instead of "A" column
Also... you can assume I have generated tabs in excel that correspond with each SelectCell.Value.
Sub Consolidate_Sheets()
Dim MyCell As Range
Dim MyRange As Range
Dim ws As Worksheet
Set MyRange = Sheets("Install_Input").Range("A2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
Call superSizeMe(MyCell, MyRange)
Sub superSizeMe(SelectCell As Range, SelectRange As Range)
Dim InstallInput As Worksheet
Dim strPasteToSheet As String
'New worksheet to paste into
Dim DestinationSheet As Worksheet
Dim DestinationRow As Range
'Define worksheet with input data
Set InstallInput = ThisWorkbook.Worksheets("Install_Input")
For Each SelectCell In SelectRange.Cells
InstallInput.Select
If SelectCell.Value <> "" Then
SelectCell.EntrieRow.Select ''''LOCATION OF RUN-TIME ERROR 438''''
Selection.Copy
Set DestinationSheet = Worksheets(SelectCell.Value)
Set DestinationRow = DestinationSheet.Range("L1:L" & DestinationSheet.Cells(Rows.Count, "L").End(xlUp).Row)
Range("L" & DestinationRow.Rows.Count + 1).Select
ActiveSheet.Paste
End If
Next SelectCell
InstallInput.Select
InstallInput.Cells(1, 1).Select
If IsObject(InstallInput) Then Set InstallInput = Nothing
If IsObject(SelectRange) Then Set SelectRange = Nothing
If IsObject(SelectCell) Then Set SelectCell = Nothing
If IsObject(DestinationSheet) Then Set DestinationSheet = Nothing
If IsObject(DestinationRow) Then Set DestinationRow = Nothing
End Sub
I am getting a Run-time error'438'
"Object doesn't support this property or method" on "SelectCell.EntireRow.Select"
Well your code has a typo
SelectCell.EntrieRow.Select
should say entire not Entrie. Personally I would use this method anyway, It selects the entire row based on the number you put in. FYI there is also a corresponding Columns().select if you need it in the future
sel_cell_row = SelectCell.Row
Rows(sel_cell_row).select
edit addressed to comment
The reason you get the 1004 error is like it says, the copy and paste areas don't match. Think of copying 10 rows, and trying to paste it into 2 rows, simply wouldn'y work. I'm guessing the problem actually stems from your destinationrows code. I'm not entirely sure what its trying to do, but here are two generic fixes
1)keep the copy code as it is, and modify the paste. Instead of selecting a range of cells to paste into, select the first cell (if your range was a1:a10, selecting a1 is sufficient) excel will then paste all the data starting at that first cell. so in your code do this
'comment out all this destination row stuff
'Set DestinationRow = DestinationSheet.Range("L1:L" & DestinationSheet.Cells(Rows.Count, "L").End(xlUp).Row)
'Range("L" & DestinationRow.Rows.Count + 1).Select
Range("L1").select 'only referencing the first cell to paste into
ActiveSheet.Paste
2)rather than selecting an entire row, why not select only the populated values in that row something like
sel_cell_row = SelectCell.Row
lastColumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
range(Cells(sel_cell_row ,1),Cells(sel_cell_row ,lastColumn )).select
then do your copy as usual. the 1 is for column 1, or A. I'm assuming the data you want is in one row starting at column A and going till lastColumn. Maybe now this will match your destinationrows code.
3)Com,bine options 1 and 2. so copy only the populated cells, and paste to the first cell in the range

Resources