Autofill Date By Week - vba

I am trying to auto fill one cell to the right by week. For example A1 = 10-July
B1 = 17-July I want to auto fill C1 and C1 only to equal 24-July. My goal is to make it dynamic because I will be using it every week. My code below auto fills by day down the column. Thanks, Becca.
Sub Autofill()
Dim LR As Long
LR = Range("ZZ1").End(xlToLeft).Column
Range("A1").Autofill Destination:=Range("A1:A" & LR)
End Sub

You want a DataSeries, not an AutoFill.
Sub Autofill()
Dim LR As Long
LR = Range("ZZ1").End(xlToLeft).Column
cells(1, "A") = date(2018, 7, 10)
Range(cells(1, "A"), cells(1, lr)).DataSeries Rowcol:=xlRows, Type:=xlChronological, Date:=xlDay, Step:=7, Trend:=False
End Sub

Sorry but what exactly restrain you from using a simple formula in B1 : =A1+7 ?

Given you only want to fill one cell, AutoFill is not the right tool. Also, calling your function the same thing as a built in method is a bad idea.
Note that this is implicitly working on the ActiveSheet (you may want to be more specific)
Try this
Sub MyAutofill()
Dim LastFilledCell As Range
Set LastFilledCell = Cells(1, Columns.Count).End(xlToLeft)
LastFilledCell.Offset(0, 1) = LastFilledCell.Value + 7
End Sub

Related

Date Comparison Issue VBA

I am trying to compare Dates in a vba script. I believe the main issue is my formatting however I am not sure how to solve it.
Sub Rem9()
Dim i As Long
Dim lr As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
wsName = ws.Name
lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
FirstDateRead = CDate("1, 1,2018") 'Initialize the first Day of the year as the last day
For i = 1 To lr
Debug.Print FirstDateRead
Debug.Print ws.Cells(i, 1).Value
If FirstDateRead > ws.Cells(i, 1).Value Then
ws.Cells(i, 3).Value = 121325
End If
Next i
End Sub
According to my output the First Date Read is never greater than the values I am pulling, Which it is for all cases. I have included here an example of the debug.print from the script I am running to show the date formats. Additionally I want to confirm the values I am drawing from are indeed datevaluse as when I run them through the IsDate() Function it returns True.
One other issue if that my date format for the value I call is swapping the year and day. Does anyone know how to solve that. When I use the format function it returns the date as.
Assuming the cells containing the dates are in text format, try wrapping the comparison value in a cDate:
If FirstDateRead > Cdate(ws.Cells(i, 1).Value) Then
ws.Cells(i, 3).Value = 121325
End If
Try using the DateDiff function instead:
Sub dateDifference()
Dim d1 As Date, d2 As Date
d1 = CDate("1, 2,2018")
d2 = Range("A1").Value ' insert a date in A1 to test
Debug.Print DateDiff("d", d1, d2) ' first parameter set to days
End Sub
Edit #1
Use Format to compare apples with apples, so to speak:
d2 = Format(Range("A1").Value, "dd/mm/yyyy")

excel vba fill column from 1 to N

I am trying to write a VBA code to autofill range A1:A10000 with numbers 1 to 10000 but without entering 1 in A1 and 2 in A2 to create a range.
Basically, I need a code that looks like this:
Set fillRange = Worksheets("Sheet1").Range("A1:A10000")
(1,2).AutoFill Destination:=fillRange
Of course this does not work, but you get what it.
Writing and reading to/from the worksheet are some of the slowest actions you can perform. Writing time-efficient code means doing as much in memory as you can.
Try writing all your values into an array, then writing the whole thing to the worksheet in one shot, something like this:
Sub printRange(total As Integer)
Dim i, myRange() As Integer
ReDim myRange(1 To total)
For i = 1 To total:
myRange(i) = i
Next i
'Use Transpose to shift the 1d array into a column
Worksheets("Sheet1").Range("A1:A" & UBound(myRange)).Value = _
Application.WorksheetFunction.Transpose(myRange)
End Sub
For total = 10000, this pretty much runs instantly, even on a ten year old dinosaur desktop.
Dim fillRange As Range
Dim i As Long
Set fillRange = Worksheets("Sheet1").Range("A1:A10000")
With fillRange
For i = .Cells(1, 1).Row To .Cells(.Rows.Count, 1).Row
.Cells(i, 1).Value = i
Next i
End With 'fillRange
Or with AutoFill :
With Worksheets("Sheet1")
Range("A1").Value = 1
Range("A2").Value = 2
Range("A1:A2").AutoFill Destination:=Range("A1:A10000")
End With 'Worksheets("Sheet1")
this should be fast enough
you could use the following function
Function FillNumbers(rng As Range) As Variant
Dim i As Long
ReDim nmbrs(1 To rng.Rows.Count)
For i = 1 To UBound(nmbrs)
nmbrs(i) = i
Next
FillNumbers = Application.Transpose(nmbrs)
End Function
in the following manner
With Worksheets("Sheet1").Range("A1:A10000")
.Value = FillNumbers(.Cells)
End With
Can't you use a simple loop?
For i = 1 to 10000
Worksheets("Sheet1").Cells(i, 1) = i
Next i
Dim fillRagne As Range
Set fillRange = Range(Cells(1, 1), Cells(1000, 1))
For Each cell in fillRange
cell.value = cell.Row
Next cell

Creating a code for Moving onto Next Row upon Clicking on Button

I am creating a macro where upon clicking on Button1, the selection(DateofRequest) would move to cell C6 and PayeesName on Cell D6; another click when the name is entered move to C7 and D7 respectively and so on and so forth until all the cells are filled.
I will appreciate any help on this. Thank you!
Public Sub CommandButton1_Click()
Dim DateofRequest As Date
Dim PayeesName As String
Worksheets("C Check Request").Select
DateofRequest = Range("C13")
Worksheets("C Check Request").Select
PayeesName = Range("C15")
Worksheets("Costume").Select
Worksheets("Costume").Range("C5").Select
RowCount = Worksheets("Costume").Range("C5").CurrentRegion.Rows.Count
With Worksheets("Costume")
RowCount = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(RowCount, 3) = DateofRequest
.Cells(RowCount, 4) = PayeesName
End With
End Sub
You are trying to increase the count in columns C and D but are looking for the last row in A.
Also your code can be shortened by getting rid of the selects and activates. Also you can assign the values directly instead of using variables.
Public Sub CommandButton1_Click()
Dim RowCount as Long
With Worksheets("Costume")
RowCount = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
.Cells(RowCount, 3) = Worksheets("C Check Request").Range("C13").Value
.Cells(RowCount, 4) = Worksheets("C Check Request").Range("C15").Value
End With
End Sub

Fill down column according to colum in another sheet

I've been a longtime viewer of this place and I love it! I've never needed to post because I've been able to find everything. However, today I am stumped and I cannot find an answer here so forgive me if this has been addressed.
The question is this:
I want to copy ColumnA (starting say, A2) from SHEET1 into ColumnB (starting B8) of SHEET2.
My problem is that the source column (SHEET1:ColumnA) has a dynamic number of rows every instance the workbook is used. I also do not want to fill down to the end of the sheet or display zeros etc.
I perceive this as a filldown problem but sourcing from another sheet. Though I may be wrong about that and cannot make it work myself.
Thanks very much in advance.
Try this:
sub copyToOtherSheet()
dim startRowASht1 as int
dim startRowSht2 as int
dim loopr as Boolean
dim counter as long
loopr = True
counter = 0
startRowSht1 = 2
startRowSht2 = 8
Do While loopr = True
Worksheets("Sheet2").Range("B" & Cstr(startRowSht2 + counter)).value = Worksheets("Sheet1").Range("A" & Cstr(startRowSht2+counter)).value
if Cstr(worksheets("Sheet1").Range("A" & Cstr(startrowsht2 + counter)).value) = "" then
loopr = False 'you reached an empty cell and it stops copying
else
counter = counter + 1
end if
End Sub
Public Sub a()
With Sheets("Sheet2")
.Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Copy Destination:=Sheets("Sheet1").Cells(8, 2)
End With
End Sub
If you are willing to use a macro:
Sub copyRange()
Dim rSource As Range
Set rSource = Range(Sheet1.Cells(2, 1), Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp))
Range(Sheet2.Cells(8, 2), Sheet2.Cells(Sheet2.Rows.count,2)).Clear
Range(Sheet2.Cells(8, 2), Sheet2.Cells(7 + rSource.Rows.Count, 2)).Value = rSource.Value
End Sub
This assumes that there is nothing below the contiguous range of values in column A on Sheet1, and that in Sheet2 you want to completely clear out whatever is in column B from row 8 down to the bottom. (If your range in column A of Sheet1 gets smaller from one invocation to the next, you don't want to leave any remnants in Sheet2)

Using the value of the last row of a column as a range?

I have a vba code that determines the date based on 3 cells in excel, it then reformats the date.
Sub Test()
Dim i As Long
i = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
Range("K3").Formula = "=DATE(A3,G3,H3)"
Range("K3").AutoFill Destination:=Range("K3:K28")
Set fmt = Range("K3:K28")
fmt.NumberFormat = "ddmmmyyyy"
End Sub
The line that gives a value to "i" (which is 28) determines the last populated cell in that column.
I would like to use the value of "i" as K28 in the range.
I am fairly new to VBA and have not been able to figure out how to accomplish this task.
You can slightly simplify your code. There is no need to use AutoFill:
Sub Test()
Dim i As Long
With Sheet1
i = .Cells(.Rows.Count, 2).End(xlUp).Row
With .Range("K3:K" & i)
.Formula = "=DATE(A3,G3,H3)"
.NumberFormat = "ddmmmyyyy"
End With
End With
End Sub