Copy the last non empty cell - vba

I have been working on a code that I need to always copy the lat NON empty cell of column C in the spreadsheet called "Support2". Then I need to paste in the spreadsheet "Final", always on the cell A2. So I will update the spreadsheet everyday and more values will be added on Column C, that's why it needs to copy always the last one. I have tried the code below but it is not working. I would appreciate your help, Thanks!
Sub test()
Dim myLastCell As Range
Set myLastCell = LastCell(Worksheets("Support2").Range("C:C"))
End Sub
' Now Copy the range:
Worksheets("Support2").Range("C:c" & myLastCell.Row).Copy
Else
MsgBox ("There is no data in specified range")
End If
End Sub

Needed another Sheet("Support2) in it
Sub test()
Sheets("Support2").Range("C" & Sheets("Support2").Range("C1").End(xlDown).Row).Copy
Sheets("Final").Range("A2").PasteSpecial (xlPasteValues)
End Sub

Related

Excel Copy a range of cell values to the clipboard

I want to copy a range of cell (values only/ text) to the clipboard so the user does not have to do a paste special values only when they paste them into another spreadsheet.
Here is what I have so far:
Private Sub CommandButton1_Click()
With New DataObject
.SetText Range("A32:Q32").Text
.PutInClipboard
End With
'Range("A32:Q32").Copy
End Sub
This gives me a runtime error
94 Invalid use of Null
If I just use the commented out code Range.("A32:Q32").Copy it copies the formulas and unless the user does the special paste they get all kinds of reference errors.
It's a bit convoluted, but get text > clear clipboard > put text back :
[A32:Q32].Copy
With New DataObject
.GetFromClipboard
s = .GetText
.Clear
.SetText s
.PutInClipboard
End With
Range.Text returns Null when the individual cell texts in the range are different.
I don’t know dataobject, so I propose a workaround by having the user select the destination cell, too
Private Sub CommandButton1_Click()
Dim userRng As Range
With ActiveSheet 'reference currently active sheet, before the user could change it via inputbox
Set userRange = GetUserRange()
If Not userRange Is Nothing Then ' if the user chose a valid range
With .Range("A32:Q32")
userRange.Resize(.Rows.Count, .Columns.Count).Value =.Value ' paste values only
End With
End If
End With
End Sub
Function GetUserRange() As Range
' adapted from http://spreadsheetpage.com/index.php/tip/pausing_a_macro_to_get_a_user_selected_range/
Prompt = "Select a cell for the output."
Title = "Select a cell"
' Display the Input Box
On Error Resume Next
Set GetUserRange = Application.InputBox( _
Prompt:=Prompt, _
Title:=Title, _
Default:=ActiveCell.Address, _
Type:=8) 'Range selection
' Was the Input Box canceled?
If GetUserRange Is Nothing Then MsgBox “Canceled!”
End Function

VBA copy non-blank cells to a master workbook

I'm a very beginner at vba. I'm trying to write a macro that helps me to loop through all workbooks in a folder going through each cell of that workbook. If the cell is empty then paste it onto the cell of a master workbook with the same position as the original one (these workbooks share the same format). this is what I have and I know that it's wrong. Please help me out. Really appreciate your advice. Thanks.
Sub copycat()
Dim x As Range
Set x = ActiveCell
For Each Cell In
Workbooks("work2.xlsm").Worksheets("sheet1").Range("a1:j10")
If IsEmpty(Cell.Value) = False Then
Workbooks("work2.xlsm").Worksheets("sheet1").Range("x").Copy
Workbooks("work2.xlsm").Worksheets("sheet1").Range("x")
End If
Next Cell
End Sub
The code below will copy all the none-empty cells in your Range.
You have not specified the destination Workbook you want to paste these values.
Sub copycat()
Dim Cell As Range
For Each Cell In Workbooks("work2.xlsm").Worksheets("sheet1").Range("A1:J10")
If Trim(Cell.Value) <> "" Then ' if cell is not empty
Cell.Copy ' <-- copy the cell
' not sure where you want to paste it ??
End If
Next Cell
End Sub

Copy values across relative worksheets

I would like to copy a range of values from one worksheet into a specified range of another worksheet whereas values always come from the previous worksheet (in the worksheet row), even after duplicating the worksheet. I'm using the following to copy values from one worksheet to the other, which seems to work:
Sub Copy_ultimo_stock()
'copy values between two periods
Worksheets("Period2").Range("test3").Value = Worksheets("Period1").Range("test2").Value
End Sub
I had to give the range of cells a name (test2 and test3), because the macro wouldn't work if I use the actual cell range like "R10:S11". In the future however, I would just like to use the cell range as "R10:S11".
My actual problem however is the following. If I duplicate my worksheets in the future (for future periods), I want that I always copy the cell range from the previous worksheet. The way I have done it now, if I copy the worksheet period2, and call it maybe period6, it will still copy values from period1 worksheet. However, I would like that the current worksheet "n" will copy values from the range in worksheet "n-1".
I have found a somewhat similar approach that could help, but I couldn't combine both macros into one. That approach is here:
Function PrevSheet(rCell As Range)
Application.Volatile
Dim i As Integer
i = rCell.Cells(1).Parent.Index
PrevSheet = Sheets(i - 1).Range(rCell.Address)
End Function
EDIT
So you requirement is a macro that imports from "the previous sheet", so that when you click the button, the subroutine first fetches the previous from the current and accordingly fetches the values.
We will suppose that all Worksheets are named like "periodx", where x is an integer identifying the period. when we create a new worksheet copy, we need first to rename the new worksheet in the form "periodx" and then click on the button to fetch the values from the sheet "periody" where y = x-1.
Just replace your button handler Copy_ultimo_stock() with this one:
Sub Copy_ultimo_stock()
Dim wsCur As Worksheet, wsPrev As Worksheet
Set wsCur = ActiveSheet
' We will suppose that all Worksheets are named like "periodx"
' where x is an integer identifying the period
On Error Resume Next ' try fetching the previous ws as "periody" where y = x-1
Dim x As Integer: x = CInt(Mid(wsCur.Name, Len("period") + 1))
Set wsPrev = ThisWorkbook.Sheets("period" & (x - 1))
If Err.Number <> 0 Then
msgBox "Could not find the previous worksheet, Please check Worksheet names"
Exit Sub
End If
On Error GoTo 0
' Now we copy the previous values. You can customize the ranges if the design changes
wsCur.Range("D2:L8").Value = wsPrev.Range("D10:L16").Value
End Sub
Moreover, you can automate the generation of a new period worksheet by adding another button, say "Generate Next Period", that will create the new ws and give it the appropriate name. This will save the user the task of copying the sheet and renaming it. The code for the new button will be like this:
Sub create_next_period()
Dim wsCur As Worksheet, wsNext As Worksheet
Set wsCur = ActiveSheet
On Error Resume Next
Dim x As Integer: x = CInt(Mid(wsCur.Name, Len("period") + 1))
If Err.Number <> 0 Then
msgBox "Please check Worksheet name. It should be named periodx"
Exit Sub
End If
Set wsNext = ThisWorkbook.Sheets("period" & (x + 1))
If Err.Number = 0 Then
msgBox "The worksheet " & wsNext.Name & " already exists"
Exit Sub
Else
Err.Clear
wsCur.Copy After:=Worksheets(Worksheets.Count)
Set wsNext = Worksheets(Worksheets.Count)
wsNext.Name = "period" & (x + 1)
wsNext.Activate
Call Copy_ultimo_stock
End If
End Sub
When you name your cells do:
Range("whatever").name="Sheet!Name"
and not just
Range("whatever").name="Name"
==> this way you can gave the same named range on several sheets without any problem
Hope this helps.
However I wouldn't advice using too much named ranges...

Copy cell values over to new worksheet but not the formatting

I am trying to copy over the cell values and contents over to a new, locked worksheet, but currently the code is bringing over the original worksheet's formatting. Currently the code I am using is:
Sub sbCopyRangeToAnotherSheet()
Sheets("LTL Quote Form").Range("A1:L33").Copy Destination:=Sheets("Sheet3").Range("A1")
Application.CutCopyMode = False
End Sub
And I've even tried:
Sub Copy()
Sheets("LTL Quote Form").Range("A5:L11").Copy
Sheets("Sheet1").Range("A5:L11").PasteSpecial xlPasteValues
End Sub
But neither of them are working. Any suggestions on how to copy over the cell values, but not the formatting?
The second example you posted will paste values, not formatting. You could also use:
Sub sbCopyRangeToAnotherSheet()
Sheets("Sheet3").Range("A1:L33").Value2 = Sheets("LTL Quote Form").Range("A1:L33").Value2
End Sub

Does there exist a VBA command which does not change the formula of a cell, but its value?

Suppose in a worksheet the formula of R4 cell is =B1+B2, and its current value is 10.
A VBA command Range("R4").Value = 5 will change both its formula and its value to 5.
Does anyone know if there exists a VBA command which changes the value of R4 to 5, but does not change its formula, such that its formula is still =B1+B2?
PS: we can also achieve the same state in another way: 1) do a Range("R4").Value = 5 2) change the formula of R4 to =B1+B2 but without evaluating it. In this case, does there exist a VBA command which change the formula of a cell without evaluating it?
Edit: What I want to do is...
I would like to write a function, which takes a worksheet where some cells may be out of date (the formula does not match its value), and generates automatically a VBA Sub, this VBA Sub can reproduce this worksheet. The VBA Sub may look like:
Sub Initiate()
Cells(2,3).Value = 5
Cells(4,5).Value = 10
...
Cells(2,3).Formula = "=2+3"
Cells(4,5).Formula = "=C2+C2"
...
End Sub
Such that running Initiate() builds one worksheet with same values and formulas.
Without the VBA command I am asking, this Initiate() will be hard to generated.
You cannot change the value of a cell to something different than what the cell formula computes to.
Regarding your p.s.: You can probably change the formula of a cell without re-evaluation by changing the calculation mode to manual. But that would of course apply to the entire workbook, not just this one cell
EDIT: maybe a solution would be to temporarily save the formula of the cell in either a tag of that cell, or a hidden worksheet?
It is quite simple to change the result of a formula without changing the formula itself:
Change the value of of its argument(s). This is a Solver-type approach:
Sub ForceDesiredResult()
Dim r As Range
Set r = Range("B2")
With r
If r.HasFormula Then
.Formula = .Formula & "-5"
Else
.Value = .Value - 5
End If
End With
End Sub
Here is some very dirty code that will save all values of all formulas on the active sheet as custom properties of the sheet, and a 2nd sub that will mark red all cells where the value has changed from it's original value, while preserving all formulas. It will need some error-checking routines (property already exists, property doesn't exist,...) but should give you something to work with. Since I don't really understand your problem it's a bit hard to say ;)
Sub AddCustomProperty()
Dim mysheet As Worksheet
Dim mycell2 As Range
Dim myProperty As CustomProperty
Set mysheet = ActiveWorkbook.ActiveSheet
For Each objcell In mysheet.UsedRange.Cells
Debug.Print objcell.Address
If objcell.HasFormula Then Set myProperty = mysheet.CustomProperties.Add(objcell.Address, objcell.Value)
Next objcell
End Sub
Sub CompareTags()
Dim mysheet As Worksheet
Dim mycell2 As Range
Dim myProperty As CustomProperty
Set mysheet = ActiveWorkbook.ActiveSheet
For Each objcell In mysheet.UsedRange.Cells
Debug.Print objcell.Address
If objcell.HasFormula Then
On Error Resume Next
If mysheet.CustomProperties(objcell.Address).Value <> objcell.Value Then
objcell.Font.ColorIndex = 3
On Error GoTo 0
End If
End If
Next objcell
End Sub