Fill down a row on VBA - vba

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'

Related

Excel VBA autofill across and down

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.

Excel VBA - If a cell in column B contains a value then column A equals "value" BUT do not overwrite existing column A data

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 <>"".

Copy Column ranges into a single series in VBA

I have data ranges that span couple of columns (C:D), (M:N) and (Q:R). I am trying to copy the first row in each of the series and paste it to another sheet. As in combine the ranges into a single range with the following sequence
The sequence of copy and pasting I am trying to do is
First row of range (C:D)
First row of range (M:N)
First row of range (Q:R)
Second row of range (C:D)
Second row of range (M:N)
Second row of range (Q:R)
and then the Third row and so on.. I am trying to paste the ranges into another sheet.
So far I have done this by copying each row at a time and pasting one after another. But I am finding it difficult to convert this into a loop which will copy and paste any number of rows to another sheet.
Sub CopyCol()
Sheets("Sheet10").Range("C2:D2").Copy
Sheets("Sheet11").Range("B2:C2").PasteSpecial xlPasteValues
Sheets("Sheet10").Range("M2:N2").Copy
Sheets("Sheet11").Range("B3:C3").PasteSpecial xlPasteValues
Sheets("Sheet10").Range("Q2:R2").Copy
Sheets("Sheet11").Range("B4:C4").PasteSpecial xlPasteValues
Sheets("Sheet10").Range("C3:D3").Copy
Sheets("Sheet11").Range("B5:C5").PasteSpecial xlPasteValues
Sheets("Sheet10").Range("M3:N3").Copy
Sheets("Sheet11").Range("B6:C6").PasteSpecial xlPasteValues
Sheets("Sheet10").Range("Q3:R3").Copy
Sheets("Sheet11").Range("B7:C7").PasteSpecial xlPasteValues
...
End Sub
The copy and paste does not stop there it goes on. I have just pasted a snippet of the code. The number of rows in each of the series is 45.
Is there a way to reduce the number of lines? I could not figure out how to do it using a loop.
Any help or any suggestions would be really helpful and really appreciated.
Thanks in advance.
See the following code - here's the points to take note of:
you can create the sheet and range references (wsSource, rngSource, etc) and this prevents you needing to constantly refer to Sheets("Sheet10") or Range("C2:D2") etc - this is also a good practice.
you can use other variables to define your range variables - the code below has two counters - one for the 45 rows of source data and one to track the target row in the other sheet
you need to loop through the source data, but you don't loop through the target data as you are appending to the same columns B:C and therefore just need a row counter tracking your position in the target sheet
HTH
Sub CopyCol()
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim rngSource As Range
Dim rngTarget As Range
Dim intSourceRowCounter As Integer
Dim intTargetRowCounter As Integer
Set wsSource = ThisWorkbook.Worksheets("Sheet10")
Set wsTarget = ThisWorkbook.Worksheets("Sheet11")
intTargetRowCounter = 1
For intSourceRowCounter = 1 To 45
Set rngSource = wsSource.Range("C" & intSourceRowCounter & ":" & "D" & intSourceRowCounter)
Set rngTarget = wsTarget.Range("B" & intTargetRowCounter & ":" & "C" & intTargetRowCounter)
rngTarget.Value = rngSource.Value
intTargetRowCounter = intTargetRowCounter + 1
Set rngSource = wsSource.Range("M" & intSourceRowCounter & ":" & "N" & intSourceRowCounter)
Set rngTarget = wsTarget.Range("B" & intTargetRowCounter & ":" & "C" & intTargetRowCounter)
rngTarget.Value = rngSource.Value
intTargetRowCounter = intTargetRowCounter + 1
Set rngSource = wsSource.Range("Q" & intSourceRowCounter & ":" & "R" & intSourceRowCounter)
Set rngTarget = wsTarget.Range("B" & intTargetRowCounter & ":" & "C" & intTargetRowCounter)
rngTarget.Value = rngSource.Value
intTargetRowCounter = intTargetRowCounter + 1
Next intSourceRowCounter
End Sub

Replace value from 1 worksheet to another using a loop

I need a way to replace values in my primary worksheet (main) with values from my secondary worksheet (update).
my main worksheet has these column names: EmpName, EmpID, EmpSupervisor, Emp Director.
and my secondary worksheet: EmpName, EmpID, New Sup, NewDir, Status.
if an entry in the 2nd worksheet has STATUS listed as "mismatch", it will automatically pass the "new sup" and/or "new dir" data with the corresponding EmpID and overwrite "empsupervisor" and/or "empdirector" in the primary sheet.
something like this, i just can't put it in a correct syntax that vba can understand.
for each STATUS = Mismatch in worksheet2
update worksheet1.column("Empsupervisor") with worksheet2.column("New Sup").value
where worksheet1.column("EmpID") = worksheet2.column("EmpID")
next
This method loops through all rows, checks for mismatch, finds the employee ID row, then moves the new supervisor and new director into the first sheet:
Sub TestIt()
Dim LastRow As Long, CurRow As Long, DestRow As Long, DestLast As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("Name of main worksheet")
Set ws2 = Sheets("Name of secondary worksheet")
LastRow = ws2.Range("B" & Rows.Count).End(xlUp).Row
DestLast = ws1.Range("B" & Rows.Count).End(xlUp).Row
For CurRow = 2 To LastRow 'Assumes first row has headers
If ws2.Range("E" & CurRow) = "mismatch" Then 'Assumes mismatch is in column E
If Not ws1.Range("B2:B" & DestLast).Find(ws2.Range("B" & CurRow).Value, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
DestRow = ws1.Range("B2:B" & DestLast).Find(ws2.Range("B" & CurRow).Value, LookIn:=xlValues, LookAt:=xlWhole).Row
End If
ws1.Range("C" & DestRow).Value = ws2.Range("C" & CurRow).Value 'assumes supervisor is in column C in both sheets
ws1.Range("D" & DestRow).Value = ws2.Range("D" & CurRow).Value 'assumes director is in column D in both sheets
End If
Next CurRow
End Sub
Explanation of LastRow:
Range("B" & Rows.Count) goes to the last row on the sheet which is Row 1,048,576 in Excel '07, '10, and '13. So imagine Range("B1048576"). Then it performs End(xlUp) which is "Equivalent to pressing END+UP ARROW" according to MSDN. This will go to the first cell in column B that is non-blank above B1048576. The last command .Row returns that row number of the cell.
Explanation of DestRow:
We are using a Range.Find() method to identify if the employeeID exists in the first worksheet and on what row it exists. Range.Find() returns a range which is why I use Range.Find().Row because when found, we want to know the row we are going to. However, if Find() doesn't find anything, it returns Nothing and Nothing.Row would error. Therefore I do a quick If Not Find() Nothing to make sure the value is found.

How to select the last range of cells in 1 range of columns and fill down to the last row in another range of columns

I am attempting to copy formulas from the last row in columns "O" to "V" down to the last used row in column "A" but I am having difficulty. This is a bit more advanced than I am used to as I can manage to get data from cell "O2" to copy down to the last row but the formula will always been in a different row and it is a large set of data I am adding to and therefore I don't wish to recalculate the full page each day.
Extract of Code
LastRow = ActiveSheet.UsedRange.Rows.Count
LR1 = Range("O" & Rows.Count).End(xlUp).Row
Range("O" & LR1).Select
Selection.Copy
LastRow = ActiveSheet.UsedRange.Rows.Count
LR2 = Range("A" & Rows.Count).End(xlUp).Row
Range("O" & LR1).AutoFill Destination:=Range("O" & LR2), Type:=xlFillDefault
It looks to be the last line that is causing the issues but it could be incorrect. To give you a bit more of what I have completed to this point- I have copied 4385 lines of data into columns "A:N" and now need to copy the formula that was in the 1st row I pasted into down to the end of my data set now + 1 extra row.
I am then wanting to select the formulas that I have copied down and paste special all but the last row of formula in columns "O to V"
Is it possible to do this?
You should be able to avoid actually selecting anything with this.
Dim LR1 As Long, LR2 As Long
LR1 = Range("O" & Rows.Count).End(xlUp).Row
LR2 = Range("A" & Rows.Count).End(xlUp).Row
Range("O" & LR1 & ":V" & LR2).FillDown
*Addendum: * The correct command was FillDown, not Autofill.