I have googled and tried various different things to get this to work but still can't find a solution.
I am still trying to learn about macros and VB so any help would be appreciated.
Basically, what I am after is a cell value on one worksheet to be the amount of rows on a second worksheet.
Picture showing what I am after
As described in the picture, the value of the source cell (number of payments) varies depending on the term/frequency/value of agreement.
I would then like that number of rows be allocated in the next worksheet, with sequential numbering.
This is what I have managed to fumble about with so far....
Sub ExtendByValue()
'
' ExtendByValue Macro
' Extends the rows by the number of repayments
'
'
Sheets("Agreement Tems").Select
Range("C8").Select
Selection.Copy
Sheets("Payments").Select
Range("M1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Rows("8:8").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
Any help with this is appreciated.
Rows("8:" & (sheets("agreementterms").range("c8").Value + 8)).select
Selection.insert shift:=xldown
incase you have value issues as specified in comments use the below.
Rows("8:" & (sheets("agreementterms").range("c8").text + 8)).select
Selection.insert shift:=xldown
try this
Option Explicit
Sub ExtendByValue()
'
' ExtendByValue Macro
' Extends the rows by the number of repayments
'
Dim nRows As Long
nRows = CLng(Sheets("Agreement Tems").Range("C8")) 'get the integer part of cell "C8" value in "Agreement Tems" sheet
With Sheets("Payments")
.Range("B8").Resize(nRows - 1).EntireRow.Insert 'insert nRows-1 below cell "B8" of "Payments" sheet, so as to have nRows with this latter included
With .Range("B8").Resize(nRows) 'of these nRows ...
.FormulaR1C1 = "=row()- row(R7)" ' ... fill column "B" with a formula returning integer form 1 to nRows ...
.Value = .Value ' ... and finally get rid of formulas and leave only values
End With
End With
End Sub
Related
I have 600k rows and want to remove starting and trailing whitespace. I have the following, but it is rather slow:
Sub Macro1()
'
' Macro1 Macro
'
'
Range("D1").Select
ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])"
Range("D1").Select
Selection.AutoFill Destination:=Range("D1:D4")
Range("D1:D4").Select
Columns("D:D").Select
Selection.Copy
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("D:D").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("C1").Select
End Sub
Is there a way that I can apply the function on itself. I would like to avoid running a function in an empty column, then copying the values to the original column.
I tried VBA to fill formula down till last row in column as well as to speed up the formula. I have a few columns to do this with, and wonder if it is possible to only work on column C and trim the whitespace without the extra computations.
Thanks
This does not use a second column and does all the values in Column C. It moves the values to an array, iterates the array and trims the excess space and overwrites the values in C with the array.
Sub macro1()
Dim rng As Variant
Dim ws As Worksheet
Dim i As Long
Set ws = Worksheets("Sheet1") 'Change to your sheet name.
With ws
rng = .Range("C1", .Cells(.Rows.Count, 3).End(xlUp)).Value
For i = LBound(rng) To UBound(rng)
rng(i, 1) = Application.Trim(rng(i, 1))
Next i
.Range("C1", .Cells(.Rows.Count, 3).End(xlUp)).Value = rng
End With
End Sub
Change the code like this so you don't use Select. Using Select and Selection slows everything down horribly.
Sub Macro1()
Range("D1").FormulaR1C1 = "=TRIM(RC[-1])"
Range("D1").AutoFill Destination:=Range("D1:D4")
Columns("D:D").Copy
Range("C1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("D:D").ClearContents
End Sub
I want to copy data from sheet "summary" row A44 (fixed row with dynamic data with formula) to sheet18 (row A3), A1 and A2 are header; i have below vba code and manage to do so. I would like to copy and paste the data as value (like Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False), so that the data will convert to absolute number, anyone how to edit the code?
Sub COPY_SUMMARY2COPYDATA()
Set des = Sheet18.Range("a1")
With Worksheets("SUMMARY")
.Rows(Range("A44").Row).Copy
des.Range("A3").Insert Shift:=xlUp
End With
Application.CutCopyMode = False
End Sub
Please try this:
Sub COPY_SUMMARY2COPYDATA()
Dim LastRow As Long
LastRow = Sheet18.Cells(Rows.Count,1).End(XlUp).Row + 1
Sheets("SUMMARY").Rows("44").Copy
Sheet18.Rows(LastRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
Hope this help
To find the first blank cell in column A look from the bottom up and offset down one row.
Use a direct value transfer with .Value2 to pass over 'the data will convert to absolute number'. This will discard regional currency and date conventions as well as formulas in favor of the raw underlying value.
with Worksheets("SUMMARY")
with intersect(.usedrange, .rows(44).cells)
Sheet18.cells(.rows.count, "A").end(xlup).offset(1, 0).resize(.rows.count, .columns.count) = .value2
end with
end with
I am trying to get a macro to delete all rows with blank cells in row "F".
Here is my code:
Sub DeleteBlanks()
On Error Resume Next
Range([indirect("V1")]).Select.EntireRow.SpecialCells(xlBlanks).EntireRow.Delete
End Sub
The indirect(V1) refers to a variable which indicates what range to work in. Currently cell V1 contains Materjal!F1:F191.
But after applying the code to a button, when i click it, it only SELECTS the range, but does not remove the rows with empty cell values.
What am I doing wrong ?
fRange = Range(Cells(1,"F"),Cells(.CountRows,"F"))
If fRange = "" Then
Cells(.countRows,"F").EntireRow.Delete
End If
Is this working?
Try this:
Sub Macro1()
Dim i As Integer
Dim last As Integer
last = ActiveSheet.UsedRange.Rows.Count
''select unused column
Range("AA1").Select
Selection.Formula = "=IF(F1 = """", ""Y"", ""N"")"
Selection.AutoFill Destination:=Range("AA1:AA" & last)
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AA1").Select
For i = 1 To last
If Selection.Value = "Y" Then
Selection.EntireRow.Delete
Else: ActiveCell.Offset(1, 0).Select
End If
Next
Columns("AA:AA").ClearContents
End Sub
I am trying to transpose every second and third row to columns B and C and then preferably delete the old rows so that I don't have two unused rows in B and C. I tried recording a macro, which worked for only the selection I made. Then I tried deleting the specific selections and replacing them with an offset range but I keep getting an error in the PasteSpecial line.
Sub SortRawData()
'
' SortRawData Macro
'
' Keyboard Shortcut: Ctrl+q
'
Selection.Offset(1, 0).Resize(Selection.Rows.Count + 2, _
Selection.Columns.Count).Select
ActiveCell.Copy
ActiveCell.Offset(-1, 1).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End Sub
I tried initially using Selection everywhere I have ActiveCell but neither seemed to work. I know I am missing the selection for the two rows I want to delete after I transpose the data into column B and C. What I have is a raw data dump of information that is formatted as:
Item1 Weight1 Color1 Item2 Weight2 Color2 Item 3 Weight 3 Color 3
I can get it to transpose one selection at a time by I can't seem to square away the automation of it.
Sub SortRawData2()
'
' SortRawData2 Macro
'
' Keyboard Shortcut: Ctrl+w
'
Selection.Copy
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Rows("2:3").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End Sub
This is the initial recorded macro and even it fails debugging at the PasteSpecial line. Any suggestions would be much appreciated!
Thanks!
Try this, then code an autofilter to remove the empty rows:
Sub SortRawData2()
Dim lLastRow As Long, lLoop As Long
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For lLoop = 1 To lLastRow Step 3
Cells(lLoop, 2) = Cells(lLoop + 1, 1)
Cells(lLoop, 3) = Cells(lLoop + 2, 1)
Cells(lLoop + 1, 1).Resize(2).ClearContents
Next lLoop
With Range("A1:A" & lLastRow)
.AutoFilter field:=1, Criteria1:="="
.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End With
End Sub
The assignment requires me to run the Monte Carlo result 1000 times. I already create a row of 30 years values(B5:AE5), and I want to repeat the process 1000 times. Every time, there will be a new row comes out, and all the values will be random.
Below is my code, for some reason, it will go to the very bottom of my excel sheet. I want the second row of 30 years values inside (B6:AE6).
Sub Macros()
Dim trail As Long
trail = InputBox("Enter the number of time you want to simulate this Macros", "Macros", "10")
For i = 1 To trail
Application.CutCopyMode = False
Range("B5").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Selection.End(xlDown).Select
Selection.Offset(-1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A4").Select
Selection.End(xlDown).Select
Selection.Copy
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMod = False
Next i
Range("B4").Select
End Sub
Thank you sooo much!
To answer your question about why your End(xlDown) takes you to the end of the sheet, the Selection.End(xlDown).Select is similar to pressing Ctrl+Down on the spreadsheet. (Likewise Selection.End(xlToRight)).Select is similar to pressing Ctrl+Right.)
Hence if you are on an empty sheet, or if all the cells beneath the active (or referenced) cell are empty, then pressing Ctrl+Down will bring you to the last row.
All that said, you can avoid that whole issue and improve your code significantly by
Removing all the Select statements and work directly with the range objects.
Using the defined range (B5:AE5) since you know what it is.
Just using the counter to resize the range to to paste the values and formats (and eliminate the loop).
See the code below:
Sub Macros()
Dim trail As Long
trail = InputBox("Enter the number of time you want to simulate this Macros", "Macros", "10")
With Range(Range("B5"), Range("AE5"))
.Copy
.Offset(1).Resize(trail - 1, 30).PasteSpecial xlPasteValues
.Offset(1).Resize(trai1 - 1, 30).PasteSpecial xlPasteFormats
End With
With Range("A5")
.Copy .Offset(1).Resize(trail - 1)
End With
'if you don't need to copy the formats you can change the above With statements to just this:
'With Range("A5:BE5")
' .Offset(i).Resize(trail - 1,31).Value = .Value
'End With
End Sub
It sounds like you want to place formulas in the selected number of rows.
Sub Frmla()
Dim i As Long
i = InputBox("enter Number")
Range("B6:AE" & 5 + i).FormulaR1C1 = "=R[-1]C*0.7"'whatever the formula is
End Sub