Fairly new to VBA. I have a macro that I'd like to change to be able to work on however many rows containing data are in the worksheet rather than the hardcoded value (46).
Sub test1calc()
'
' test1calc Macro
'
'
'1 - UNSTRESSED POSTED PRODUCT LEVEL BREAKDOWN SUMMED AT NETTING SET
Columns("AS:AS").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AS1").Select
Selection.Interior.Pattern = xlSolid
Selection.Interior.PatternColorIndex = 2
Selection.Interior.Color = 65535
ActiveCell.FormulaR1C1 = "Unstressed Posted Total"
Range("AS2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-30]:RC[-1])"
Range("AS2").Select
Selection.AutoFill Destination:=Range("AS2:AS46")
Range("AS2:AS46").Select
ActiveSheet.Calculate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
I'm assuming you want to fill the rows where there is existing data to the left, not the millions of rows that exist in your worksheet.
If so, I believe your code can be simplified to the following:
Sub test1calc()
'1 - UNSTRESSED POSTED PRODUCT LEVEL BREAKDOWN SUMMED AT NETTING SET
Columns("AS:AS").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
With Range("AS1")
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = 2
.Interior.Color = 65535
.Value = "Unstressed Posted Total"
End With
With Range("AS2:AS" & Range("O" & Rows.Count).End(xlUp).Row)
.FormulaR1C1 = "=SUM(RC[-30]:RC[-1])"
.Value = .Value
End With
End Sub
Related
I want to merge the first and the last row using the =cell1&cell2 function of the table but was unable to as the number of row can be dynamic.
Tried using the relative distance using ctrl+up but to no avail.
Ideally a VBA code where I can use the "&" function to merge the most top and last row of the table then paste special on top as text
Sub Macro9()
ActiveCell.FormulaR1C1 = "=R[-9]C&R[-2]C"
ActiveCell.Select
Selection.Copy
Selection.End(xlUp).Select
Selection.End(xlToRight).Select
ActiveCell.Offset(2, 0).Range("A1").Select
Range(Selection, Selection.End(xlToLeft)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
If I understand correctly , what you want is a way to address the last cell in a column.
You can do this as follows:
Set sht = Sheets("main")
column = 1
lastRow = sht.Cells(sht.Rows.Count, column).End(xlUp).Row
Set lastCell = sht.Cells(lastRow, column)
lastCell is a range variable referencing the last cell in the column specified by the column variable. I explicitly referenced the sheet to avoid problems with active sheets.
Sub MergeCells()
col = 1 // column A
lastRow = Cells(Rows.Count, 1).End(xlUp).row
Mcell = Cells(1, col) & Cells(lastRow, col)
End Sub
I am having some issues with my VBA code that will select data from one sheet, copy it, paste it to a new sheet and insert a total at the bottom of the table. The first steps work, but I am struggling with the total , any help would be greatly appreciated. Here is what I have so far:
Range("A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "='Pricing Main'!RC[1]"
Range(xlToRight, xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(R[-36]C:R[-1]C)"
End Sub
If the problem is in making formula with dynamic range (while first row is always the same and the 2nd is different), you could use:
ActiveCell.FormulaR1C1 = "=SUM(R1C:R[-1]C)"
If you're using number without "[]" it will absolute address with $
In this example it will be ="SUM(A1:Ax)" where X is row before active cell
Another option is using Activecell.Formula and get this address by combining letters with Activecell.row
activecell.Formula = "=SUM(A1:A" & activecell.Row - 1 &")"
And after that you can autofill to other columns if needed by
activecell.AutoFill Destination:=range(activecell, activecell.Offset(0,5)), Type:=xlfilldefault
3rd option could be using range variables calculate address before formula:
Sub Makro1()
Dim rng1 As Range Dim rng2 As Range Dim rng3 As Range
Set rng1 = Range("A1") Set rng2 = ActiveCell.Offset(-1, 0) Set rng3 = Range(rng1, rng2)
ActiveCell.Formula = "=SUM(" & rng3.Address & ")"
End Sub
If you have another problem, please, try explain it better ;)
I need a macro to append a comma onto the beginning of a column of text strings. I recorded the action myself, but it limited itself to Column C (often, the text strings I need to do this with appear in a different column), and also limited the application of the range to the specific number of rows in the worksheet I recorded it on (in this case, 114).
Here is the original Record Macro output:
Sub AddCommaToESIID()
'
' AddCommaToESIID Macro
'
'
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C2").Select
ActiveCell.FormulaR1C1 = ","
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C114")
Range("C2:C114").Select
Range("E2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E114")
Range("E2:E114").Select
Selection.Copy
Range("D2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("E:E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
End Sub
I would like to modify this to achieve the following:
Make the macro apply to whatever Column I have selected, as opposed to Column C
Once I have selected a Column, make the macro apply to however many rows there are in the particular worksheet I'm working on.
Thanks in advance for your help!
This will change all non-formulas in whatever range you select
Sub AddCommaToESIID()
Dim rCell As Range
If TypeName(Selection) = "Range" Then
For Each rCell In Selection.Cells
If Not rCell.HasFormula Then
rCell.Value = "," & rCell.Value
End If
Next rCell
End If
End Sub
Sub DOBdateRange()
Dim Bfordate As Date
Dim Afterdate As Date
Bfordate = Worksheets("error").Range("i5").Value
Afterdate = Worksheets("error").Range("j5").Value
Application.ScreenUpdating = False
'çhange data formate to Date
Worksheets("data").Select
Worksheets("data").Range("a2", Range("a" & Rows.count).End(xlUp)).Offset(, 3).Select
Selection.Name = "DOB"
Selection.NumberFormat = "d/mm/yyyy"
'filter and copy how many records match (exclude) date criteria,
Worksheets("Data").Select
Range("bq1").Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.AutoFilter
ActiveSheet.Range(Selection, Selection.End(xlDown)).AutoFilter _
**Field:=4, _
Criteria1:="<" & Bfordate, _
Operator:=xlOr, _
Criteria2:=">" & Afterdate**
Range("a1").Select
Range("bq1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy Set NewSheet = Sheets.Add(After:=Worksheets("error"))
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
On Error GoTo duplicatesheet3
NewSheet.Name = "DOBdateRange"
On Error GoTo 0
NewSheet.Range("A1").Select
Application.CutCopyMode = False
Worksheets("dobdaterange").Range("d:d").Select
Selection.NumberFormat = "d/mm/yyyy"
Application.CutCopyMode = False
Worksheets("dobdaterange").Range("a1").Select
Range(Selection, Selection.End(xlToRight)).EntireColumn.AutoFit
With ActiveSheet.UsedRange.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Worksheets("Data").Select
Worksheets("Data").Range("A1").Select
Selection.AutoFilter 'Remove auto filter
Sheets("DOBdateRange").Select
Exit Sub
Previously I was using range. Value to refer to date criteria since it wasn't working I thought its not picking up date format so I declared the dates as date, still its not filtering all the data, its generating incomplete result, after much searching and trying different things i decided to post it for direction. any help pointing to right direction will be highly appreciated. Thank you
I work with excel 2010 and have created a macro to copy a row of text data, transpose it into a column and then add commas after each value. Now I want the same macro to also find a pre-determined value in the column and replace it with another pre-determined value. Here is what I have so far...
Sub Macro2()
'
' Macro2 Macro
'
' Keyboard Shortcut: Ctrl+q
'
Range("E2:CL6").Select
Selection.Copy
Range("A11").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
x = 1
Do While Cells(11, x) <> ""
Cells(11, x).Select
Set Rng = Range(Selection, Selection.End(xlDown))
For Each cell In Rng
cell.Value = cell.Value + ","
Next
x = x + 1
Loop
Application.CutCopyMode = False
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells.Select
Cells.EntireColumn.AutoFit
Range("B1").Select
ActiveCell.FormulaR1C1 = "user id"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Pin"
Range("B2").Select
End Sub
Here is your code (a bit more cleaner without the .Select) :
Sub Macro2()
'
' Macro2 Macro
'
' Keyboard Shortcut: Ctrl+q
'
Range("E2:CL6").Copy
Range("A11").PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=True
x = 1
Do While Cells(11, x) <> ""
Set Rng = Range(Cells(11, x), Cells(11, x).End(xlDown))
For Each cell In Rng
cell.Value = CStr(cell.Value & ",")
cell.Value = Replace(cell.Value, "Fixed Income Research Group", "SS FixedIncomeResearch")
cell.Value = Replace(cell.Value, "Fixed Income Trading Group", "SS FixedIncomeTrading")
Next
x = x + 1
Loop
Application.CutCopyMode = False
Columns("B:B").Insert Shift:=xlToRight, _
CopyOrigin:=xlFormatFromLeftOrAbove
Columns("B:B").Insert Shift:=xlToRight, _
CopyOrigin:=xlFormatFromLeftOrAbove
Cells.EntireColumn.AutoFit
Range("B1").FormulaR1C1 = "user id"
Range("C1").FormulaR1C1 = "Pin"
End Sub