I have a count down timer in excel and as it counts down i would like to copy and paste range of cells to another, based on 60 mins and minute to the end i have written the time i would like the macro to do this in j1 and input the ranges but i cant get it to work.
Sub MyMacro(my_macro)
If Cells(4, 6) = j1 Then
Range("g9:G64").Select
Selection.Copy
Range("L9:l64").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
If Not apllication.insersect(Range(j1), Range(target.Address)) Is Nothing
Then
End Sub
any help would be greatly appreciated
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("K4")) Is Nothing Then
If Range("K4") < Range("J1") Then
Range("G9:G64").Copy
Range("L9").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
End If
End Sub
Related
I have two cells (R5 and S5) that are aggregates based on a RAND() function. I want to create a running list of those values, which change every time the sheet recalculates. The list should have about 100K iterations of this. I wrote a "dumb" bit of VBA that copy/pastes the values into a list.
This does sort of work, but is too slow to scale to 100k iterations and I get a gap every 50 records for some reason.
There must be a better / faster way to do this with a loop or something like that? TIA.
Sub Macro2()
'
' Macro2 Macro
'
'
Range("R5:S5").Select
Selection.Copy
Range("U5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("U6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("U7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
A Worksheet Calculate
Sheet Module e.g. Sheet1
Option Explicit
Private Sub Worksheet_Calculate()
Macro2 Me
End Sub
Standard Module e.g. Module1
Option Explicit
Sub Macro2(ByVal ws As Worksheet)
Application.EnableEvents = False
Dim lCell As Range
Set lCell = ws.Cells(ws.Rows.Count, "U").End(xlUp).Offset(1)
lCell.Resize(, 2).Value = ws.Range("R5:S5").Value
Application.EnableEvents = True
End Sub
I am having a hard time trying to figure out why the code is not running when I try to use it for a big set of data. I need to do a transposition per batches of 144000 data points from rows to columns.
I did a trial for working with a VBA code that allows me to do a transposition per batches of data from 2RX5C to 5RX2C. the code works:
Sub Macro1()
End Sub
Sub transpose()
'
' transpose Macro
'
' Keyboard Shortcut: Ctrl+Shift+T
'
Range("A1:E2").Select
ActiveCell.Range("A1:E2").Select
Selection.Copy
ActiveCell.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, transpose:=True
Do Until IsEmpty(ActiveCell)
ActiveCell.Offset(5, -7).Range("A1:E2").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, transpose:=True
Loop
End Sub
However, when I adequate the code for working with 24RX56C to 56RX24C, the code does not run once I include Do until IsEmpty(ActiveCell) and Loop. (It skips all the code between these two)
Sub TRANSPOSE()
'
' TRANSPOSE Macro
'
' Keyboard Shortcut: Ctrl+Shift+T
'
Range("B2:BE25").Select
ActiveCell.Range("A1:BD24").Select
Selection.Copy
ActiveCell.Offset(0, 60).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, TRANSPOSE:=True
Do until IsEmpty(ActiveCell)
ActiveWindow.SmallScroll Down:=57
ActiveCell.Offset(56, -60).Range("A1:BD24").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(0, 60).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, TRANSPOSE:=True
Loop
End Sub
I am stuck for a month now and I would appreciate any help.
Macro recorder is not much use for something like this - you need to read up a little on how to set and manipulate Range variables, in addition to avoiding Select/Activate
Sub TRANSPOSE()
Dim rng As Range, rngP As Range
Set rng = ActiveSheet.Range("B2:BE25") 'source range
Set rngP = rng.Cells(1).Offset(0, rng.Columns.Count + 1) 'destination range
Do While Len(rng.Cells(1).Value) > 0
rng.Copy
rngP.PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, TRANSPOSE:=True
'offset source and destination ranges
Set rng = rng.Offset(rng.Rows.Count, 0)
Set rngP = rngP.Offset(rng.Columns.Count, 0)
Loop
End Sub
I am looking to write a code to :
copy cell A14 into the first row of column H,
move down the entire column (most recent data on top),
and then time stamp in column I when the value changes
But I cannot seem to get it running and working properly.
I am trying to keep real time tracking of these values and create a time series graph.
This needs to execute on its own.
Any thoughts?
Private Sub Gain(ByVal target As Range)
Application.EnableEvents = True
Do While cell("A14") <> cell("H1")
If cell("H1") <> cell("A14") Then
Range("H1:J1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A14").Select
Selection.Copy
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A16").Select
Application.CutCopyMode = False
Selection.Copy
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B16").Select
Application.CutCopyMode = False
Selection.Copy
Range("J2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("I:I").Select
Application.CutCopyMode = False
Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
Columns("J:J").Select
Selection.NumberFormat = "m/d/yyyy"
Columns("H:H").Select
Selection.NumberFormat = "$#,##0.00"
Next
End Sub
This will track any changes and paste the current time in Column I. It looks like your copying and pasting code should be working; if not, please let us know what (if any) errors or results you are getting.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
rng = Range("A:A")
If Intersect(Target, rng) Is Nothing Then
'Do nothing
Else:
If Target.Value <> Now Then
Cells(Target.Row, 9).Value = Now
Cells(Target.Row, 9).NumberFormat = "hh:mm:ss"
Else
End If
End If
End Sub
This is what I have so far. I need a sub to copy a group of cells and paste their values on the next empty cell available. The error I'm getting is in selecting that first available cell. Any thoughts?
Dim workline As Integer
Sub Test()
With ActiveSheet
workline = 11
While .Cells(workline, 2) <> Empty
workline = workline + 1
Wend
End With
Range("B3:CH9").Select
Selection.Copy
range(workline,2) .Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Message = MsgBox("Data copied succesfully", vbInformation + vbOKOnly, "Aecon Mining")
End Sub`
Not tested in Excel, but should work, or at least pointing you to the right direction:
Range("B3:CH9").Copy
Range("B2").end(xlDown).offset(1,0).paste 'first available cell
And stop using those .Select and selection everywhere, they are a total waste of time.
How can I copy some data from one worksheet to another?
I tried this code, but get an error:
Private Sub CommandButton2_Click()
Sheets("Gas Opt").Select
Range("A1:A3").Select
Selection.Copy
Sheets("ExportToPPServer").Select
Cells(3, AColumn).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
LFound = True
MsgBox "Data coped."
End Sub
Error:
Select method of Range class failed.
Something like this should work:
Private Sub CommandButton2_Click()
Dim copyRng As Range, targetRng As Range
Set copyRng = Worksheets("Gas Opt").Range("A1:A3")
Set targetRng = Worksheets("ExportToPPServer").Cells(3, AColumn)
copyRng.Copy
targetRng.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
LFound = True
MsgBox "Data coped."
End Sub
How does this look?
Sub x()
Sheets("Gas Opt").Select
Range("A1:A3").Select
Selection.Copy
ActiveWorkbook.Sheets("ExportToPPServer").Range("A1:A3").PasteSpecial Paste:=xlValues
End Sub
Edit
Is your Control button on a different sheet than "Gas Opt"? That would explain it. Try this:
Sub x()
Sheets("Sheet2").Range("A1:A3").Copy
ActiveWorkbook.Sheets("Sheet3").Range("A1:A3").PasteSpecial Paste:=xlValues
End Sub
You need to activate the sheet, else you cannot select cells in it.
Sheets("ExportToPPServer").Activate ' Instead of select