Ok... I am struggling with something that is probably simple... I have a formula in cell B2 and I want to fill to the last cell that contains data or formatting (same as when you press CTRL+END) or in other words "the bottom right corner" of my data. How do I do this? There is data in column "A" and in row "1"... So it needs to fill to the last row and last column containing data...
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Range("B2").AutoFill Destination:=Range(Range("B2"), Cells(2, lastCol)), Type:=xlFillDefault
Range("B2:B" & lastCol).AutoFill Destination:=Range("B2"), Cells(lastRow, lastCol)), Type:=xlFillDefault
The below code helps you determine, and reference, your "box range." The code is making 3 assumptions that you may need to amend for if incorrect:
1) The "top left corner" of your box range is B2
2) Values in Col B span to the bottom of your range. If you expect blanks in Col B, change this to a different column.
3) Values in row 2 span to the end of your used columns. If you expect blanks in row 2, change this to a different row.
Sub RangeBox()
Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets(1)
Dim LRow As Long
Dim LCol As Long
LRow = WS.Range("B" & WS.Rows.Count).End(xlUp).Row
LCol = WS.Cells(2, Columns.Count).End(xlToLeft).Column
MsgBox "Last Row: " & LRow & vbNewLine & "Last Column: " & LCol
'How to refer to the box range starting from A1
Dim Start As Range
Set Start = WS.Range("B2")
WS.Range(Start, WS.Cells(LRow, LCol)).Select
End Sub
To fill this range with a formula:
WS.Range(Start, WS.Cells(LRow, LCol)).Formula = "=Sum(1,2)"
Inside the quotes, type the equation in as you would in excel and used locked references if needed ($). The above example would fill your range with the value 3.
Related
The title of the question might be a little confusing but essentially what I am trying to do is write a value to column A if Column B is not empty. This must be repeated for C through Q. The code I have now produces the desired result IF there is value in the B column. However, if there is no value for B then my replacement text will fill in all sorts of blank cells outside of the target range of A1:A. Here is the code I have:
Sub Update_Column_Based_On_Column_Value_1()
On Error Resume Next
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).Formula = "=If(B1<>"""",""NEW VALUE"","""")"
.Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value
End With
End Sub
I am fairly new to VBA so please forgive any vagueness in my post.
Instead of inserting formulas and getting their values afterwards, you can do the same logic by using pure VBA:
Sub Update_Column_Based_On_Column_Value_1()
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = 1 To lRow
If .Cells(i, 2) <> "" Then
.Cells(i, 1) = "NEW VALUE"
End If
Next i
End With
End Sub
This formula will only work if A1 is the first blank.
.Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).Formula = "=If(B1<>"""",""NEW VALUE"","""")"
.SpecialCells(xlCellTypeBlanks) may be a discontiguous range of areas that may or may not start in row 1. You need to convert it to an xlR1C1 style formula in order to have it correctly identify the first blank row.
.Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=If(LEN(RC2),""NEW VALUE"", TEXT(,))"
TEXT(,) is the same as "" and you do not have to double-up the quotes within a quoted string; similarly, any positive number representing the length of a value in column B is the same as <>"".
So I have a macro which takes an invoice I have copied into a worksheet, and copies the premium amount and pastes it onto the summary tab in the cell that corresponds with the same social security number on both sheets. Here is the macro:
Sub Eyemed2()
Dim rw, LastRow, LastRRow As Long
Dim rng As Range, Found As Range, SheetEnd3 As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("Eyemed 2")
Set ws2 = Sheets("Raw")
LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Set rng = ws2.Range("A2:B" & LastRow)
LastRRow = ws1.Cells(Rows.Count, "R").End(xlUp).Row
For rw = 14 To LastRRow 'Begin in row 14 of Eyemed 2
If Not ws1.Range("R" & rw) Is Nothing Then
is blank
Set Found = rng.Find(What:=ws1.Range("A" & rw).Value,
LookIn:=xlValues)
If Not Found Is Nothing Then
ws2.Range("N" & Found.Row) = ws1.Cells(rw, "J").Value
Else
Set SheetEnd3 = rng.Find(What:=ws1.Range("A" & rw).Value,
LookIn:=xlValues)
LastRow = ws2.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row
ws1.Range("A" & rw).Copy ws2.Range("B" & LastRow)
ws2.Range("N" & SheetEnd3.Row) = ws1.Cells(rw, "J").Value
End If
End If
Next rw
End Sub
So it looks at column R in 'Eyemed 2' and if it isn't blank, then copy over the cell in column N into the summary tab, column J. It finds the appropriate row to paste in the summary tab by searching for the social security number in column A of 'Eyemed 2' in column A:B in the summary tab.
My issue is that in 'Eyemed 2', some of the social security numbers are listed more than once with two different amounts. So I need to edit the macro to sum all amounts with the same social security number and then search and paste into one entry in the summary tab as opposed to now where it just copies and pastes one amount.
Thank you very much
If there are multiple matches then this just leaves you with the last value found:
ws2.Range("N" & Found.Row) = ws1.Cells(rw, "J").Value
...but this will add each value to any previous value
With ws2.Range("N" & Found.Row)
.Value = .Value + ws1.Cells(rw, "J").Value
End with
I am trying to find out how to fill down (or copy?) a row (lastUsedRow) up to the last row. However I find myself struggling with designating ranges (especially because I am working on different datasets that have different sizes).
Before
I need to spot the lastUsedRow (lastUsedRow = .Range("A" & .Rows.Count).End(xlUp).Row) - which is row 31 here. It designates the latest row where there was data in column A.
Then I want to tell VBA to fill down until the last row (lastRow) - row 39 - which can be found using lastRow = .Range("E" & .Rows.Count).End(xlUp).Row. It designates the latest row where there was data in column E.
After
Question
VBA recommends to work with Range().FillDown but I struggle with designating the range when coding for changing datasets. More precisely, how to I write down a range that is between lastUsedRow and lastRow?
I think you want to fill down Columns A thru D, from the lastUsedRow (defined from Col A) to the lastRow (defined from Col M), using the values from lastUsedRow in columns A:D.
Dim lastRow as Long, lastUsedRow as Long
Dim srcRange as Range, fillRange as Range
With Worksheets("Sheet1")
lastUsedRow = .Range("A" & .Rows.Count).End(xlUp).Row
lastRow = .Range("M" & .Rows.Count).End(xlUp).Row
' Fill values from A:D all the way down to lastUsedRow
Set srcRange = .Range("A" & lastUsedRow & ":D" & lastUsedRow)
Set fillRange = .Range("A" & lastRow & ":D" & lastUsedRow)
fillRange.Value = srcRange.Value
End With
If you need to preserve formatting, then use the Copy method:
srcRange.Copy Destination:=fillRange
Note: +1 to you for using See correct way to find the 'last row'
I would like to start at cell A2 and then select every 6th cell in that column. Next, I want to insert a cell and shift everything to the right.
This is what I have that works so far, but it's long and takes forever to type out:
Range("A2,A8,A14,A20,A26,A32,A38,A44,A50,A56,A62,A68,A74").Select
Selection.Insert Shift:=xlToRight
Please tell me there is a more simple expression to get the desired output.
Thanks.
do it in a loop so you don't have to type it all out.
for i = 2 to 10000 step 6
range("A" & i).Select
Selection.Insert Shift:=xlToRight
next
you don't have to do the select, you can also do range("A"&i).insert Shift:=xlToRight
You can use Union Function to set the range and then move all cells together.
Sub Demo()
Dim rng As Range
Dim lastRow As Long
'get last row in column "A"
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
'set range using Union function
For i = 2 To lastRow Step 6
If rng Is Nothing Then Set rng = Range("A" & i)
Set rng = Union(Range("A" & i), rng)
Next
'move range to right
rng.Insert Shift:=xlToRight
End Sub
you could go like follows:
For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlNumbers)
If (cell.Row - 2) Mod 6 = 0 Then cell.Insert Shift:=xlToRight
Next cell
but should your need be not actually shifting cells (i.e. shifting ALL row cells at the right of the relevant one) but rather their values only then you could go like follows:
For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
If (cell.Row - 2) Mod 6 = 0 Then cell.Offset(, 1) = cell: cell.ClearContents
Next cell
which is much faster
a few words about what you see in code above:
the Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row) part takes care to consider only column "A" cells from "A1" down to its LAST non empty one
the .SpecialCells(xlCellTypeConstants) part takes care to furtherly filter the former range considering only cells with a "constant" (i.e. not resulting from a formula) value in it
you could even be more specific like
SpecialCells(xlCellTypeConstants, xlTextValues)
which would consider only "constants" (as above defined) string values
SpecialCells(xlCellTypeConstants, xlNumbers)
which would consider only "constants" (as above defined) numeric values
the same can be achieved for cell with formulas only just by typing xlCellTypeFormulas instead of xlCellTypeConstants
If a row contains the value "car" I am trying to copy the contents of the ID cell to A1.
For example, if row D12 contains "car" I want to copy the contents of cell B12 to A12.
Currently this is my code:
Dim lastRow As Long
Dim cell As Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row + 1
For Each cell In Range("D2:D" & lastRow)
If InStr(1, cell.Value, "CAR") <> 0 Then
cell.Offset(0, -3).Value = "test"
End If
Next
So currently the code find's the rows that has "car" but populates the cell with the value "test". I am struggling with how to reference/copy the cell over.
This is because the first column of my worksheet requires a concatenation of values as the ID and I do not want to apply it to this string.
Thanks for any advice/help!
The reason you get "test" as inserted in to column A is, that is what the code is specifying. The code needs to be changed to reflect what is wanted.
If the contents of column B is wanted, then replace the string "test" with:
cell.Offset(0, -2).Value
So the whole line would read:
cell.Offset(0, -3).Value = cell.Offset(0, -2).Value
Since you are iterating through column D, cell is located in column D. The offset part is saying, "Move over three places from column D and place the value from two columns over". Or column A on the same row, which is 3 cells to the left from the current cell in column D and place the value from Column B on the same row, which is 2 cells to the left of the current cell in column D.
Another quick way would be to use the autifilter.
For example:
Sub Button1_Click()
Dim lastRow As Long
Dim rng1 As Range, rng2 As Range
Application.ScreenUpdating = 0
lastRow = Range("D" & Rows.Count).End(xlUp).Row + 1
Columns("D:D").AutoFilter Field:=1, Criteria1:="=*Car*"
Set rng1 = Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible)
Set rng2 = Range("B2:B" & lastRow).SpecialCells(xlCellTypeVisible)
rng1.Value = rng2.Value
ActiveSheet.AutoFilterMode = 0
End Sub