I'm trying to write code which automates something: I've got a table of data which I need to add a column into, then put a sum in which goes all the way down to the bottom row of data and no further. I know how to define the bottom row as a variable; but what if the column I'm entering the data can vary too? In my example, the column I want to do the sums in is always to the left of the column entitled '16'. It will always start at row 2, but it won't always be column O. It might be column P, or Q, for example.
Sub enter_column_and_add_calculations()
Dim NBottomrow
Call find_bottom_row
NBottomrow = ActiveCell.Row
'find column entitled '16':
Range("A1").Select
Cells.Find(What:="16", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
'insert new column to the left:
Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
'insert text in the cell:
ActiveCell.FormulaR1C1 = "OOT Debt"
'offset one cell below:
ActiveCell.Offset(1, 0).Range("A1").Select
'i'm now in the cell i want my range to start at. In this example it's cell O2, but it often varies:
ActiveCell.FormulaR1C1 = "=SUM(RC[1]:RC[5])"
Selection.AutoFill Destination:=Range("O2:O" & NBottomrow)
End Sub
Private Sub find_bottom_row()
Range("A1").Select
Selection.End(xlDown).Select
End Sub
Many thanks for your help :-)
Try,
Sub enter_column_and_add_calculations()
dim m as variant, lr as long
with worksheets("sheet1")
m = application.match(16, .rows(1), 0)
if iserror(m) then exit sub
lr = .cells(.rows.count, m).end(xlup).row
.cells(lr+1, m).formula = "=sum(" & .range(.cells(2, m), .cells(lr, m)).address(0,0) & ")"
end with
end sub
Related
I am interested in doing this: IF Cell C14 = Cell $C$8, THEN keep the cell value BUT remove the IF formula. For rest of the Cells in Column C with IF Formula (False condition: "InsertText!"), retain the IF formula
Refer to Image here
I've tried multiple ways of phrasing the VBA syntax but I'm not getting the desired result.
Sub convertToValue()
Dim totRow As Long
Dim rng As Range
' Find row with word InsertText in it
totRow = Cells.Find(What:="InsertText", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Row
Set rng = Rows("C:C")
rng.Copy
rng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
Is there a way to do this? Thanks!
This works for me with my test spreadsheet.
Sub convertToValue()
LastRow = ActiveCell.SpecialCells(xlLastCell).Row
' change the 13 in the line below to whichever row the data
' actually starts on (the one after the table header)
For Row = 13 To LastRow
Set CurrentCell = Range("C" & Row)
' do the copy/paste only if the current cell is a
' formula AND it doesn't evaluate to "Insert Text"
If Left(CurrentCell.Formula, 1) = "=" And CurrentCell.Value2 <> "Insert Text" Then
Range("C8").Copy
CurrentCell.PasteSpecial Paste:=xlPasteValues
End If
Next
Range("C3").Select
End Sub
If you assign it to a button then you can set the product, enter new details, push the button, and repeat.
I have certain values in my column A.
For exapmple:
Header
A
A
C
C
D
D
E
F
I want to keep rows having D and remove all other. As a first step, Have sorted my sheet.
Now trying below code but its giving error of
Invalid or unqualified reference
Dim strA As Range
Dim strB As Range
Range("A:A").Select
Selection.Find(What:="D", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(-1, 0).Select
Set strA = .ActiveCell
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, ActiveCell.Offset(1, 0).Select).Select
ActiveCell.Offset(1, 0).Select
Set strB = .ActiveCell
Range(strA, strB).Select
End Sub
Maybe something like this :
Sub test()
n = Application.WorksheetFunction.CountIf(Range("A:A"), "D")
Set c = Range("A:A").Find("D", lookat:=xlWhole)
Range("A" & c.Row, Range("E" & c.Row).Offset(n - 1, 0)).Copy Destination:=Range("A2") 'change E as needed, depends how many column is your data
Set rngDel = Range("A1").Offset(n + 1, 0)
Range(rngDel, rngDel.End(xlDown)).EntireRow.Delete
End Sub
Before running the code, the data table must be sort first by column A.
The code will count how many "D" are there in column A.
Then it get the cell where it find the first "D"
From there it copy all the cells which has "D" value
then paste it to cell A2
lastly, it delete the remaining cells which doesn't have "D" value
I have a excel sheet with around 50k rows and i need a macro to search for a cell in that sheet and if it finds it to copy the entire row to another sheet, my problem is that the keyword may be on multiple rows so if there are like 4 cells with that keyword i need it to copy all 4 rows and paste them in another sheet
Dim intPasteRow As Integer
intPasteRow = 2
Sheets("Sheet2").Select
Columns("A:AV").Select
On Error Resume Next
Selection.Find(What:="m12", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=True, SearchFormat:=True).Activate
If Err.Number = 91 Then
MsgBox "ERROR: 'Keyword' could not be found."
Sheets("Sheet1").Select
End
End If
Dim intRow As Integer
intRow = ActiveCell.Row
Rows(intRow & ":" & intRow).Select
Selection.Copy
Sheets("Sheet1").Select
ActiveSheet.Paste
End Sub
Sub saci()
Dim rng As Range
Set rng = Range(ActiveCell, ActiveCell.Offset(10000, 0))
rng.EntireRow.Select
With Selection.EntireRow
.Cut
.Offset(.Rows.Count + 1).Insert
.Select
End With
Range("A4").Select
End Sub
so far its finding the first "m12" cell in Sheet2 and copies the entire row to Sheet1, how do i make it continue to search after finding "m12" and copy all rows with the "m12" in them instead of just the first one?
I want to implement a VBA Code to work with multiple different sheets, for example: it starts by looking for a certain number in the first row, once it's found, it jumps to that column and types a certain formula into the 2nd cell in that column, so far it works good, But the issue is that I wanna make it to Autofill that formula down the column if the first cell in that row contains data.
Like if A2 is not blank, continue the auto fill the cell in the active column (let's say the active column is D, then the it would fill the Cell d2 if a2 not blank) and stops once the cell in A Column is blank .. etc
So, Is it possible?
Sub Macro1()
Rows("1:1").Select
Selection.Find(What:="156", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(1).Select
ActiveCell.FormulaR1C1 = _
"= "Formula will be here""
End Sub
Might be best to save a copy of your workbook before running the code below.
Maybe something like this is what you're after. If Find found something in column D, then it puts the dummy formula in the range D2:D?, where ? is whatever the last row in column A is (which I think is what you described).
Option Explicit
Sub Macro1()
Dim ws As Worksheet
Set ws = ActiveSheet ' Can you refer to the workbook and worksheet by name? Please do if possible
With ws
Dim cellFound As Range
Set cellFound = .Rows(1).Find(What:="156", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
If cellFound Is Nothing Then
MsgBox ("The value was not found in the first row of sheet '" & ws.Name & "'. Code will stop running now")
Exit Sub
End If
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range(cellFound.Offset(1), .Cells(lastRow, cellFound.Column)).FormulaR1C1 = "=""Formula will be here"""
End With
End Sub
Check this simple code, I think it will satisfy your needs:
Sub Macro1()
Rows("1:1").Select
Selection.Find(What:="156", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
col_Num = ActiveCell.Column
total_Rows = WorksheetFunction.CountA(Range("A:A"))
Cells(2, col_Num).Select
Cells(2, col_Num) = "=Put your Formula here"
begin_Cell = Cells(2, col_Num).Address(False, False)
end_Cell = Cells(total_Rows, col_Num).Address(False, False)
Selection.AutoFill Destination:=Range(begin_Cell & ":" & end_Cell)
End Sub
There are easier ways to locate a column header label although I'm unclear on why you are using the LookAt:=xlPart argument. It seems to me you should not have to 'wildcard' the search but a 'wild card' search can be accommodated.
Sub FindnFill()
dim m as variant
with worksheets("sheet1")
m = application.match("*156*", .rows(1), 0)
if not iserror(m) then
if not isempty(.cells(2, "A")) then
.range(.cells(2, m), .cells(.rows.count, "A").end(xlup).offset(0, m-1)).formula = _
"=""formula goes here"""
else
.cells(2, m).formula = _
"=""formula goes here"""
end if
end if
end with
end sub
Find & Fill
About the Find Method
It is best practice to always set the following three parameters, because they
are saved each time they are used.
LookIn - If you use xlFormulas, it will find e.g. =A2 + 156, which you don't want.
LookAt - If you use xlPart it will find e.g. 1567, which you don't want.
SearchOrder - Not important, since a row is being searched.
Additionally SearchDirection is by default xlNext and can therefore safely be omitted.
Additionally MatchCase is by default False and can therefore safely be omitted.
Additionally SearchFormat - To use it you previously have to set Application.FindFormat.NumberFormat and can therefore safely be omitted.
The Code
Sub FindFill()
Const cDblFind As Double = 156 ' Found Value
Const cLngRow As Long = 1 ' Found Row Number
Const cVntColumn As Variant = "A" ' First Column Letter/Number
Const cStrFormula As String = "=RC[-1]+5" ' Formula
Dim objFound As Range ' Found Column Cell Range
Dim lngRow As Long ' First Column Non-empty Rows
With ActiveSheet.Rows(cLngRow)
' Check if cell below cell in First Column and Found Row is empty.
If .Parent.Cells(cLngRow, cVntColumn).Offset(1, 0).Value = "" Then Exit Sub
' Calculate First Column Non-empty Rows.
lngRow = .Parent.Cells(cLngRow, cVntColumn).End(xlDown).Row - cLngRow
' Find cell in Found Row containing Found Value.
Set objFound = .Find(What:=cDblFind, After:=.Cells(.Row, .Columns.Count), _
LookIn:=xlValues, LookAt:=xlWhole, Searchorder:=xlByRows)
If Not objFound Is Nothing Then
' Write Formula to Found Column Range
objFound.Offset(1, 0).Resize(lngRow).FormulaR1C1 = cStrFormula
End If
End With
End Sub
I have two sheets:
Database
Macro sheet: It has a row with dates that will be the headings of a table after the macro.
Objective: In the macro sheet take the value of the first date and look for its position in the database sheet. Then, in the database sheet, copy the entire column corresponding to the previously copied date.
I understand that the code should look something like this:
Sheets("Macro").Select
Range("K3").Select
Selection.Copy
Sheets("Database").Select
Cells.Find(What:=Selection.PasteSpecial xlValues, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Macro").Select
ActiveSheet.Paste
This code does not work, because the search part is not done well, I will appreciate some correction
Something along these lines.
Read this to learn the advantages of not using Select or Activate.
When using Find, always check first that your search term is found to avoid an error. For example, you cannot activate a cell that does not exist.
Sub x()
Dim r As Range
With Sheets("Database")
Set r = .Cells.Find(What:=Sheets("Macro").Range("K3").Value, lookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not r Is Nothing Then
Range(r, r.End(xlDown)).Copy Sheets("Macro").Range("A1")
End If
End With
End Sub
Loop through he header dates in the Macro worksheet. If any can be found in the header row of the Database worksheet, copy that column to the Macro worksheet under the header.
sub getDateData()
dim h as long, wsdb as worksheet, m as variant, arr as variant
set wsdb = worksheets("database")
with worksheets("macro")
for h=1 to .cells(1, .columns.count).end(xltoleft).column
m = application.match(.cells(1, h).value2, wsdb.rows(1), 0)
if not iserror(m) then
arr = wsdb.range(wsdb.cells(2, m), wsdb.cells(rows.count, m).end(xlup)).value
.cells(2, h).resize(ubound(arr, 1), ubound(arr, 2)) = arr
end if
next h
end with
end sub