I have recorded a macro to avoid repletion of same task ,
but the first average formula is getting disappeared after execution , please look into the program and kindly help where to correct.
**Actual steps what i want to execute:
Average of column c, min of column c, max of column c, average of min & max (all 4 adjacent cells p1,q1,r1,s1)
Standard deviation of column c ( cell : p2)
6 * standard deviation (cell : p3)
ABS(p1 - s1)/0.31 (cell : p4)
0.62/(p3) (cell : p5)
p5*(1-p4)**
Sub Macro5()
'
' Macro5 Macro
'
' Keyboard Shortcut: Ctrl+t
'
ActiveCell.FormulaR1C1 = "=AVERAGE(C[-13])"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "=MIN(C[-14])"
Range("R1").Select
ActiveCell.FormulaR1C1 = "=MAX(C[-15])"
Range("S1").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-2]:RC[-1])"
Range("P2").Select
ActiveCell.FormulaR1C1 = "=STDEV(C[-13])"
Range("P3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=6*R[-1]C"
Range("P4").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-3]C-R[-3]C[3])/0.31"
Range("P5").Select
ActiveCell.FormulaR1C1 = "=0.62/R[-2]C"
Range("P6").Select
ActiveCell.FormulaR1C1 = "=R[-1]C*(1-R[-2]C)"
Range("P5").Select
End Sub
Following the logic of the generated code (i.e. without any optimisation), you need to first select cell P1. In your code the average of column C is entered in the selected cell just before you execute the code.
Try this
Sub Macro5()
'
' Macro5 Macro
'
' Keyboard Shortcut: Ctrl+t
'
Range("P1").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(C[-13])"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "=MIN(C[-14])"
Range("R1").Select
ActiveCell.FormulaR1C1 = "=MAX(C[-15])"
Range("S1").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-2]:RC[-1])"
Range("P2").Select
ActiveCell.FormulaR1C1 = "=STDEV(C[-13])"
Range("P3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=6*R[-1]C"
Range("P4").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-3]C-R[-3]C[3])/0.31"
Range("P5").Select
ActiveCell.FormulaR1C1 = "=0.62/R[-2]C"
Range("P6").Select
ActiveCell.FormulaR1C1 = "=R[-1]C*(1-R[-2]C)"
Range("P5").Select
End Sub
Related
Hi I am trying to automate insertion of columns and moving of data within a certain part of a spreadsheet.
Currently What the Macro is
Sub Macro1()
'
' Macro1 Macro
'
'
Rows("6:9").Select
Selection.Insert Shift:=xlDown
Range("F5").Select
Selection.Cut
Range("E6").Select
ActiveSheet.Paste
Range("G5").Select
Selection.Cut
Range("E7").Select
ActiveSheet.Paste
Range("H5").Select
Selection.Cut
Range("E8").Select
ActiveSheet.Paste
Range("I5").Select
Selection.Cut
Range("E9").Select
ActiveSheet.Paste
Range("A5").Select
Selection.Copy
Range("D6:D9").Select
ActiveSheet.Paste
Range("C6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "10000"
Range("C7").Select
ActiveCell.FormulaR1C1 = "20000"
Range("C8").Select
ActiveCell.FormulaR1C1 = "30000"
Range("C9").Select
ActiveCell.FormulaR1C1 = "40000"
Range("C10").Select
End Sub
How do i change it so that it will update dynamically when i select a new set of rows again ?
With the following edited macro you can select any number of rows to be inserted and with inputbox
Option Explicit
Sub Macro1()
Dim newRows As Range, newRowsAddress As String, previousRow As Range
Dim ColumnLetter As String, i As Long, j As Long
On Error Resume Next
Set newRows = Application.InputBox("Select rows to insert", "New Rows", , , , , , 8)
If newRows Is Nothing Then Exit Sub
On Error GoTo 0
Set previousRow = newRows.Offset(-1).Resize(1, Columns.Count)
newRowsAddress = newRows.Address
' Rows("6:9").Select
' Selection.Insert Shift:=xlDown
' Range("F5").Select
' Selection.Cut
' Range("E6").Select
' ActiveSheet.Paste
' Range("G5").Select
' Selection.Cut
' Range("E7").Select
' ActiveSheet.Paste
' Range("H5").Select
' Selection.Cut
' Range("E8").Select
' ActiveSheet.Paste
' Range("I5").Select
' Selection.Cut
' Range("E9").Select
' ActiveSheet.Paste
newRows.Insert Shift:=xlDown
Set newRows = Range(newRowsAddress)
ColumnLetter = Split(Cells(1, 5 + newRows.Rows.Count).Address, "$")(1)
newRows.Columns("E:E").Value = Application.Transpose(previousRow.Columns("F:" & ColumnLetter).Value)
' Range("A5").Select
' Selection.Copy
' Range("D6:D9").Select
' ActiveSheet.Paste
newRows.Columns("D:D").Value = Application.Transpose(previousRow.Columns("A:A").Value)
' Range("C6").Select
' Application.CutCopyMode = False
' ActiveCell.FormulaR1C1 = "10000"
' Range("C7").Select
' ActiveCell.FormulaR1C1 = "20000"
' Range("C8").Select
' ActiveCell.FormulaR1C1 = "30000"
' Range("C9").Select
' ActiveCell.FormulaR1C1 = "40000"
' Range("C10").Select
j = 1
For i = newRows.Rows(1).Row To newRows.Rows(newRows.Rows.Count).Row
Range("C" & i) = j * 10000
j = j + 1
Next i
End Sub
Two New Rows
or Seven New Rows
Try using the "Use Relative References" option when recording your macro.
I try
Do
Selection.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=R[-1]C+0.01"
Loop Until ActiveCell.Value = "$C$1"
But it's not working
Pls. help
i try to add + 0.01 from first value (1) until equal last value (1.9)
Here is my all code
[Sub ExtractRC()
Range("A2:A" & Range("A2").End(xlDown).Row).Select
Cells(Rows.Count, "A").End(xlUp).Select
Selection.Copy
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("k2").Select
ActiveCell.FormulaR1C1 = Range("A2").Value
Do
Selection.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=R\[-1\]C+0.01"
Loop Until ActiveCell.Value = "$C$1"
End Sub][1]
P.S. Value in Column A can change
Sub Print_New()
'
' Print_New Macro
'
'
ActiveSheet.Unprotect
ActiveSheet.Range("$B$7:$G$24").AutoFilter Field:=1, Criteria1:="<>"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.Range("$B$7:$G$24").AutoFilter Field:=1
ActiveSheet.Protect
Sheets("Bill (1)").Copy Before:=Sheets(5)
ActiveSheet.Unprotect
Range("C8:C17,D20,E20:F20").Select
Range("E20").Activate
Selection.ClearContents
Range("G20").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""","""",5%)"
Range("F8").Select
Range("F8").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F9").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F10").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F11").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F12").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F13").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F14").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F15").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F16").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F17").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("C8").Select
ActiveSheet.Protect
ActiveWorkbook.Save
End Sub
Need a proper code instead of any "IF" formula.
When I write something in any cell in the range C8:C17, the default value 1 should be equal to the same cell in the range F8:F17. Which can be changed. And when C8:C17 is empty then F8:F17 should also be empty.
Please don't do the constant Select and ActiveCell: you might replace:
Range("G20").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""","""",5%)"
by:
Range("G20").FormulaR1C1 = "=IF(RC[-2]="""","""",5%)"
And, instead of using RC, you might do the following:
Range("G20").Formula = "=IF(Offset(-2;0)="""","""",5%)"
In top of this, you can use the whole range of F8:F17:
Range("F8:F17").Formula = "IF(Offset(-3;0)>0,1,"""")"
This is already a big decrease of obsolete code.
Hey i just created a macro added headers deleted info and got data formatted
but i noticed that when i ran it for another file
it just deleted the data in that exact cell i now need to
do the same
but delete the row that the phrase sits on
imagine i had a cell a1 in other versions of the document that phrase could be in a2
my macro would only delete whats in A1
the phrase is ZFD
and whatever cell its in i need the macro to delete the entire row that phrase sits on
HELPPPPP
Sub UMR()
'
' UMR Macro
'
'
Range("A1").Select
ActiveCell.FormulaR1C1 = "Transaction_Type"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Meter_Point_Ref"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Actual_Read_Date"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Meter_Reading_Source"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Meter_Reading_Reason"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Meter_Serial_Number"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Meter_Reading"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Meter_ROC_Count"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Meter_Read_Verified"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Corrector_serialNumber"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Corrector_serial_Number"
Range("K1").Select
ActiveCell.FormulaR1C1 = "Corrector_Uncorrected_Reading"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Corrector_Corrected_Reading"
Range("M1").Select
ActiveCell.FormulaR1C1 = "Corrector_ROC_Count"
Range("N1").Select
ActiveCell.FormulaR1C1 = "Corrector_Usable_IND"
Range("O1").Select
ActiveCell.FormulaR1C1 = "Corrector_Read_Verified"
Range("A17").Select
Selection.ClearContents
Range("B17").Select
Selection.ClearContents
Columns("C:C").ColumnWidth = 8.29
Columns("C:C").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("A:A").EntireColumn.AutoFit
Columns("E:E").Select
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
Columns("I:I").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit
Range("Q1").Select
Columns("K:K").EntireColumn.AutoFit
Columns("L:L").EntireColumn.AutoFit
Range("R1").Select
Columns("M:M").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
Columns("O:O").EntireColumn.AutoFit
ActiveWindow.SmallScroll Down:=6
ActiveWindow.SmallScroll ToRight:=-9
ActiveWindow.SmallScroll Down:=-88
End Sub
As I just did have the time I reorganized your code a little. Be aware that this is not commonly done here on stackoverflow. For next time: At least try to code something, if it's wrong that's not a problem, that's where we can help. And for your information: I am quite the newby as well (3,5 months of vba so far), so it's not that hard. Even if my code is not perfected yet, most of the time I can get it to work somehow...
Try this once (read the comments in the code first):
Sub UMR()
Dim WS As worksheet
Set WS = AcitveWorkbook.ActiveWorksheet 'be aware this will always be run on the activesheet
Dim Values AS Variant
Values = Array("Transaction_Type", "Meter_Point_Ref", "Actual_Read_Date", "Meter_Reading_Source", "Meter_Reading_Reason", "Meter_Serial_Number", "Meter_Reading", "Meter_ROC_Count", "Meter_Read_Verified", "Corrector_serialNumber", "Corrector_serial_Number", "Corrector_Uncorrected_Reading", "Corrector_Corrected_Reading", "Corrector_ROC_Count", "Corrector_Usable_IND", "Corrector_Read_Verified")
Dim FindString As String
FindString = "ZFD"
Dim ZFDVal As Variant
Dim IRow As Integer
Dim ICol As Integer
Set ZFDVal = Ws.Find(What:=FindString, _
After:=Ws.Cells(Ws.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _ 'If the value is only a part of a cell it would be xlPart instead of xlWhole
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False) 'If you want it to Match the string exactly (regarding capital letters) you'll have to set this to true
IRow = Range(ZFDVal.Adress).Row 'This is untested...
For ICol = 1 To (UBound(Values)-LBound(Values))
Ws.Cells(IRow, ICol) = Values(ICol-1)
Next ICol
Range("A17").Clear ' I believe this was unintendet and just recorded alongside so you can delete these two rows...
Range("B17").Clear
Columns("A:O").EntireColumn.AutoFit
End Sub
If you get a run-time error please press "debug" and comment which line gets marked yellow. This way we can help you correcting the code...
I have a functioning macro that copy pastes the static values of live data from the live data sheet (Sheet), onto a separate sheet (Sheet2) every second. The code is below. For your information, Range("B2:B2195") are stock codes while Range("H2:H2195") are stock quotes.
Sub copypaste_RECENT()
Dim ab As Integer
Worksheets("Sheet").Range("B2:B2195").Copy
With Sheets("Sheet2")
.Range("B1").PasteSpecial Transpose:=True
ab = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(1, 1).Value = "Time"
.Cells(ab, 1).Value = Now
Worksheets("Sheet").Range("H2:H2195").Copy
.Range("B" & ab).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With
Application.OnTime Now + TimeSerial(0, 0, 1), "copypaste_RECENT"
End Sub
My next step is one that im having trouble with. I would like to record the difference between the stock quotes. This means calculating the difference between a certain cell and the cell above it and recording this difference onto a separate sheet (Sheet3). This would run simultaneously to the code above so I've tried to include an additional code after End With and before the Application. The code is below.
Worksheets("Sheet").Range("B2:B2195").Copy
With Sheets("Sheet3")
.Range("B1").PasteSpecial Transpose:=True
Dim xy As Long, yz As Long
ab = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
bc = .Cells(1, .Columns.Count).End(x1toleft).Column + 1
.Cells(1, 1).Value = "Time"
.Cells(ab, 1).Value = Now
xy = Worksheets("Sheet2").Cells(.Rows.Count, 1).End(x1up).Row
yz = Worksheets("Sheet2").Cells(.Rows.Count, 1).End(x1up).Row.Offset(-1, 0)
For ab = 1 To Cells(Rows.Count, 1).End(x1up).Row + 1
For bc = 1 To Cells(1, Columns.Count).End(x1toleft).Column + 1
.Cells(ab, bc).Value = xy - yz
Next ab
Next bc
End With
I'm quite new to VBA and I know this is completely wrong. I've been struggling for a while but I hope it makes some sort of sense.
Thanks in advance!
Grant
EDIT1: This is a simple computation that calculates the difference between a certain cell and the cell above it and records this value onto a separate sheet. This computation is done for every cell in the range.
I am not comletely cleat what you like to achieve. Is it alog, so you write consecutive lines of copied and computed entries, or is is just some computation. So depending on this you have at least three options:
1) copy/paste with math functions
using the copy/past with the special mathematical functions (add, substract, multiply, divide)
2) formulas
you enter in sheet3 the formuala into B2 =+sheet2!B4-sheet2!B3 which will compute this automatically.
3) compute an store the difference
make a computation as above and copy/paste the result to the final destination.
EDIT
Excel is designed to do computations! So why do you want to redo this?
You can do all of the mentioned solutions as VBA. The same way as you did is with your copy and paste above.
Here is a short makro which shows what I mean.
Sub Makro1()
'
' Makro1 Makro
'
'
ActiveCell.FormulaR1C1 = "Line 1"
Range("B1").Select
ActiveCell.FormulaR1C1 = "8"
Range("C1").Select
ActiveCell.FormulaR1C1 = "5"
Range("D1").Select
ActiveCell.FormulaR1C1 = "6"
Range("E1").Select
ActiveCell.FormulaR1C1 = "4"
Range("F1").Select
ActiveCell.FormulaR1C1 = "6"
Range("G1").Select
ActiveCell.FormulaR1C1 = "3"
Range("A2").Select
ActiveCell.FormulaR1C1 = "12"
Range("A2").Select
ActiveCell.FormulaR1C1 = "Line 2"
Range("B2").Select
ActiveCell.FormulaR1C1 = "15"
Range("C2").Select
ActiveCell.FormulaR1C1 = "456"
Range("D2").Select
ActiveCell.FormulaR1C1 = "23"
Range("E2").Select
ActiveCell.FormulaR1C1 = "42"
Range("F2").Select
ActiveCell.FormulaR1C1 = "45"
Range("G2").Select
ActiveCell.FormulaR1C1 = "77"
Range("A1:G1").Select
Selection.Copy
Range("A5").Select
ActiveSheet.Paste
Range("B2:G2").Select
Application.CutCopyMode = False
Selection.Copy
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, _
SkipBlanks:=False, Transpose:=False
End Sub