Autofill Destination from Active Dynamic Selection to certain cell - excel

I have used the following codes to select the last 3 rows (dynamic position) in fixed columns of so that I can extrapolate till cell Q37.
selection of last 3 rows in column Q R and S
Sheets("Data").Select
LastRow = Range("S" & Rows.Count).End(xlUp).Row
Set Last3Rows = Range("Q" & LastRow - 2, "S" & LastRow)
Last3Rows.Select
I am unable to proceed to autofill these values till row 37 since the last 3 cells' position vary for different worksheets.
The code I used to autofill from the dynamic ending was:
Last3Rows.Select
Range ("Q:S" & Range("Y" & Rows.Count).End(xlUp).Row), Type:=xlFillDefault
Range("Q18:S37").Select
Y is a column with values will row 37.
How can I proceed to autofill?

Notice you din't use .AutoFill method in your example.
I hope I've understood what you asked:
LastRow = Range("S" & Rows.Count).End(xlUp).Row
Set Last3Rows = Range("Q" & LastRow - 2, "S" & LastRow)
Last3Rows.AutoFill Destination:=Last3Rows.Resize(37 - LastRow + Last3Rows.Rows.Count, 3)

This is a line of code that does what I think you are asking. The first part select the range you want to paste and the second part the range you want to copy from.
Sheets("Data").Range("Y37:AA39").Value = Range("Q" & Cells.Rows.Count).End(xlUp).Offset(-2).Resize(3, 3).Value

Related

Autofill not populating until last row

I am trying to populate the date and have it populate the column until the last row of data. However it doesn't seem to populate to the last line of data and I don't understand why. What is wrong with my code?
Sub updatedate()
lastRow = Range("F" & Rows.Count).End(xlUp).Row
Range("F2:F" & lastRow) = Date
Range("F2:F" & lastRow).Style = "Normal"
Range("F2:F" & lastRow).Value = Format(Date, "yyyymmdd")
End Sub
the date in format yyyymmdd to be updated and populated on each row until last in column F
The problem is on the line
lastRow = Range("F" & Rows.Count).End(xlUp).Row
If you change "F" to "A" (or any other suitable column) it will work better.
The last used cell in the F column is not yet used.

Copying Multiple Ranges to Next Available Row

I'm copying rows of data from one spreadsheet to another on a button press when cell I says "Yes" and deleting the original row of data. I have multiple ranges I'm copying from the same row, because the second spreadsheet doesn't need all the data held in the first. (first spreadsheet has over 20 columns worth of data but the second has half that). Is there an easy way to make sure this all gets copied to the same row in the new spreadsheet?
Basically what I'm currently doing is copying each of the ranges to the corresponding column in the new spreadsheet with the row number set to being the last used row offset by 1. Which works fine if the previous cells actually have data in, but sometimes they don't (the data is on households and some have more data than others so not all columns are always filled) so the data is placed in a different row from the rest of my data for that particular household.
Private Sub CommandButton1_Click()
Dim c As Range
Dim r As Integer
Dim LastRowD
Dim LastRowR
Dim Database As Worksheet
Dim DeReg As Worksheet
'Set worksheet deignation as needed
Set Database = ActiveWorkbook.Worksheets("Fostering Households")
Set DeReg = ActiveWorkbook.Worksheets("De-Registrations")
LastRowD = Database.Cells(Database.Rows.Count, "A").End(xlUp).Row
'Searches all rows in I
For Each c In Database.Range("I1:I" & LastRowD)
'Catches cases where "Yes" is present in column I
If c = "Yes" Then
LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0)
r = c.Row
'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab
Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("H" & r).Copy DeReg.Range("AJ" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("J" & r & ":X" & r).Copy DeReg.Range("H" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("AN" & r).Copy DeReg.Range("W" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("AS" & r).Copy DeReg.Range("X" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("AZ" & r & ":BH" & r).Copy DeReg.Range("Y" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next c
For i = 250 To 1 Step -1
If Database.Range("I" & i) = "Yes" Then
Database.Rows(i).EntireRow.Delete
End If
Next i
End Sub
I've tried defining the last row based on whether "A" has data in (this is the only cell that is always used) with the code:
LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0) and then replacing my copy past code with:
Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR & ":B" & LastRowR).Row
But this didn't work at all - it copied the first row it found with "Yes" in infinitely and overwrote all the data already present.
I also tried:
Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR).PasteSpecial
which also came with a world of problems and errors.
What I want is to search for the last used Row based on what's in column A, offset by 1, and then past the data in the column I designate, rather than the last row used being defined by the column I'm trying to paste in - is this even doable? I can't seem to find any information on this particular issue.
Also, if there is a better way of handing multiple ranges that would be great as it seems rather convoluted currently!
DeReg.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) evaluates to:
DeReg.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Offset(1, 0), so unless DeReg is the activesheet, you will get the wrong range.
See if this helps:
.... other code
'LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0)
r = c.Row
'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab
With Database
LastRowR = DeReg.Range("A" & DeReg.Rows.Count).End(xlUp).Row + 1
.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR)
.Range("H" & r).Copy DeReg.Range("AJ" & LastRowR)
.Range("J" & r & ":X" & r).Copy DeReg.Range("H" & LastRowR)
.Range("AN" & r).Copy DeReg.Range("W" & LastRowR)
.Range("AS" & r).Copy DeReg.Range("X" & LastRowR)
.Range("AZ" & r & ":BH" & r).Copy DeReg.Range("Y" & LastRowR)
End With
End If
... other code
Some helpful tips:
i is not declared. Declare as Long.
LastRowR, r & LastRowD should be declared as Long.
Replace ActiveWorkbook with ThisWorkbook.
The copy paste method used may slow down the program, because this method copies and pastes both values and formatting.
When you want to paste in the line after last row, use +1 (Example: LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row +1
Just a couple thoughts. Firstly, you have declared multiple things that are unnecessary (IMO). I have adjusted your for loop to simply loop through a value that then references the range you want. This way you can use the i value a lot more efficiently than first setting a range and then looping through and referencing the row etc.
Additionally, based on the understanding I get from your post, if you use the .UsedRanged method your outputs will start at the last row on the new sheet, irregardless of your previously chosen method by column. I have not tested the below code, but it should guide you in a clearer way.
Option Explicit
Private Sub CommandButton1_Click()
Dim i As Long
Dim LastRowD As Long
Dim LastRowR As Long
Dim Database As Worksheet
Dim DeReg As Worksheet
'Set worksheet deignation as needed
Set Database = ActiveWorkbook.Worksheets("Fostering Households")
Set DeReg = ActiveWorkbook.Worksheets("De-Registrations")
LastRowD = Database.Cells(Database.Rows.Count, "A").End(xlUp).Row
'Searches all rows in I
For i = 1 To LastRowD
'Catches cases where "Yes" is present in column I
If Database.Range("I" & i) = "Yes" Then
LastRowR = Database.UsedRange.Rows.Count + 1
'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab
Database.Range("A" & i & ":G" & i).Copy DeReg.Range("A" & LastRowR)
Database.Range("H" & i).Copy DeReg.Range("AJ" & LastRowR)
Database.Range("J" & i & ":X" & i).Copy DeReg.Range("H" & LastRowR)
Database.Range("AN" & i).Copy DeReg.Range("W" & LastRowR)
Database.Range("AS" & i).Copy DeReg.Range("X" & LastRowR)
Database.Range("AZ" & i & ":BH" & i).Copy DeReg.Range("Y" & LastRowR)
End If
Next i
For i = 250 To 1 Step -1
If Database.Range("I" & i) = "Yes" Then
Database.Rows(i).EntireRow.Delete
End If
Next i
End Sub

VBA loop, repeat formula through column

I am trying to replicate in VBA the simple function in excel which allows you to repeat a function through an entire column, and stops when the columns on the side are empty. Specifically, I want to repeat an if - else if function for the entire relevant part of the column
Here's an attempt which does not really work
Sub RepeatIfElseif
Range("A1").Select
If selection > 0 Then
Range("B1").Select
ActiveCell.FormulaR1C1 = "X"
Range("A1").Select
ElseIf selection <= 0 Then
Range("B1").Select
ActiveCell.FormulaR1C1 = "Y"
End If
Range("B1").Select
selection.AutoFill Destination:=Range("B1:B134")
Is there any way I can do it with a loop?
You do not need to loop to drop formulas in. You just need to know where the last row is!
Pick a column that is most likely to represent your last row (I am using Column A in my example) and then you can dynamically drop-down your equation in one line without the loop.
The below will fill in the equation A2 + 1 in Column B starting from 2nd row (assuming you have a header row) down to the last used row in Column A
Option Explicit
Sub Formula_Spill()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- Update sheet!
Dim LR As Long
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row '<-- Update column!
ws.Range("B2:B" & LR).Formula = "=A2+1" '<-- Update formula!
End Sub
If you want to use a loop, you can use something like the code below:
For i = 1 To 134
If Range("A" & i).Value > 0 Then
Range("B" & i).FormulaR1C1 = "X"
Else
Range("B" & i").FormulaR1C1 = "Y"
End If
Next I
It can be done without a loop, something like:
Range("B1:B134").Formula = "=IF(A1>0," & Chr(34) & "X" & Chr(34) & "," & Chr(34) & "Y" & Chr(34) & ")"
Not sure what formula you are trying to achieve with .FormulaR1C1 = "Y" ?
I'm trying to improve my English, I swear...
I would do something like this:
dim row as long
dim last_row as Long
last_row = ActiveSheet.Range("A1048576").End(xlUp).Row
For row = 1 to last_row
If Range("A" & row).Value > 0 Then
ActiveSheet.Range("B" & row).Value = "X"
Else
ActiveSheet.Range("B" & row).Value = "Y"
End If
Next row
Hope this helps.

Conditional Concatenate and Autofill with Value from Adjacent Column

Sub Concatenate ()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("K2").Formula = "= TODAY() - I2"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K" & LastRow)
For i = 2 To LastRow
If Range("K" & i).Value < 5 Then Range("J2:J" & i).Value = "Week of" & "" & ("I2:I" & i)
Next i
End Sub
I have a spreadsheet that lists item numbers in Column A, and corresponding dates in column I. Not every item will have a date, so I'm basing the LastRow on Column A to work around the gaps. I want dates in the past to return 0 in column J. I want future dates to return "Week of __" there the __ is the date in column I.
I'm not the most familiar with VBA, and I've run into a bit of a snag. With the above, everything returns "Week of9". I know it's a simple answer, but I have been Googling for an hour. I just need to know the syntax to make the above return the value of "I" at the end of the concatenate as it loops down the rows. If this is a duplicate question, I apologize.
Thanks in advance.
Maybe your condition should be:
If Range("K" & i).Value < 5 Then Range("J" & i).Value = "Week of " & Range("I" & i)

How to stop every time cells changing to value after coping data to another sheet in EXCEL

I would like to write perfectly working code but am faced with this issue. I want to transfer the data as values to another sheet. To fill out the data I use a form with formulas inside cells.
Then every time I click to transfer the data to another sheet it replaces the source data with its values in both sheets, but for me need that forms cells in the sheet1 stay unchanged. I use a form with formula to put data in the sheet1 from different sources, so it should work every time then I use it (now, after each click I have to recover formulas in the sheet1).
Here is the code:
Sub Button4_Click()
Dim x As Long
Dim erow as Long
'Calculate starting rows
x = 15
With Worksheets("Sheet2")
erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
End With
With Worksheets("Sheet1")
Do While .Cells(x, 1) <> ""
'Current code replaces the source data with its values'
.Range("A" & x & ":Y" & x).Value = .Range("A" & x & ":Y" & x).Value
'The next line copies values to Sheet2
Worksheets("Sheet2").Range("A" & erow & ":Y" & erow).Value = .Range("A" & x & ":Y" & x).Value
'increment row counters
x = x + 1
erow = erow + 1
Loop
End With
End Sub
You can't write to a cell's .Formula and then add unrelated data to the same cell's .Value - writing to .Value deletes the formula.
So the following code line:
.Range("A" & x & ":Y" & x).Value = .Range("A" & x & ":Y" & x).Value
is unnecessary (and damaging).

Resources