Referring from my previous question.
VBA code to add current date in next cell
How do I select the previous ten days data from current date entry. Example :As per my first screenshot Lets say i get the today entry will be on Column E and I want to select previous 10 entries to create a graph. So, if I come tomo, my entry will be on F and I want to select column F,E,D,C,,,,
Keeping you previous code from link, try this (untested):
edited after OPs clarifications
Option Explicit
Sub Update()
Dim nCols As Long, nOffset As Long
With Range("A1").CurrentRegion
With .Offset(, .Columns.Count - 1).Resize(1, 1)
If .value < Date Then nOffset = 1
With .Offset(, nOffset)
.Resize(2, 1).value = Application.Transpose(Array(Date, Application.WorksheetFunction.Subtotal(103, Worksheets("Stock").UsedRange.Columns(1).SpecialCells(XlCellType.xlCellTypeVisible))))
nCols = IIf(.Column > 10, 10, 10 - .Column - 1)
.Offset(, -nCols + 1).Resize(, nCols).Select
End With
End With
End With
End Sub
Related
I´m new in VBA Excel. I´m trying to make a macro which is not difficult, but I´m so inexperienced.
I have sheet1 with column of dates (whole month), for each date there is different value. So column A is full of dates and column B is full of values (in relation with date). Sheet2/column A is also created by dates (whole month).
I would like to create a macro, which copy the value from sheet1/column B and pass it to sheet2/column B according to date. In other words, the macro should find certain date (in sheet2/column A) and pass specific value to sheet2/column B.
Try this, you might need to change some values to match you workbook.
Like the sheets name and starting row on the for loop.
Sub sheetValues()
'collect information in sheet one into an array
With Sheets("Sheet1")
'check last filled in cell in column / last date
Set last = .Range("A:A").Find("*", .Cells(1, 1), searchdirection:=xlPrevious)
'new array with range information
sheetOneInfo = .Range(.Cells(1, 1), .Cells(last.Row, 2)).Value
End With
With Sheets("Sheet2")
'check last filled in cell in column / last date
Set last = .Range("A:A").Find("*", .Cells(1, 1), searchdirection:=xlPrevious)
'for each cell in range
For n = 1 To last.Row
'if value in sheet two is in array
If InArray(.Cells(n, 1).Value, sheetOneInfo) > 0 Then
'put collected value in appropriate cell
.Cells(n, 2).Value = sheetOneInfo(InArray(.Cells(n, 1).Value, sheetOneInfo), 2)
End If
Next
End With
End Sub
Function InArray(val As String, arr As Variant) As Double
InArray = 0
'for each value in array
For n = 1 To UBound(arr)
'if date in array matches cell date
If arr(n, 1) = val Then
'return date position
InArray = n
Exit Function
End If
Next
End Function
You can try something like this code below. You can change numbers 100 depending how many data you have or if it changes you can calculate it.
For i = 1 To 100
For j = 1 To 100
If Sheets(2).Cells(j, 1) = Sheets(1).Cells(i, 1) Then
Sheets(2).Cells(j, 2) = Sheets(1).Cells(i, 2)
End If
Next j
Next i
I'm just trying to check the latest Date cell, which is in Column A, against the current date. If the difference is 30 days, I write a new row.
When I execute, it says I can't call CheckAttendance on Sheet("Occurences"). But why?
Option Explicit
Public LastCell As Long
Public today As Date
Function CheckAttendance()
Dim DaysSinceOcc As Integer
'returns last occupied row
LastCell = Cells(Rows.Count, 1).End(xlUp).Row
'gets current date
today = Date
'subtracts last cell in specified column from today's date.
DaysSinceOcc = today - Cells(LastCell, 1).Value
'writes what I want written in the cells I want it written in.
If DaysSinceOcc > 29 Then
Cells(LastCell, 1).Offset(1, 1) = "winback"
Cells(LastCell, 1).Offset(1, 2) = -0.5
Cells(LastCell, 1).Offset(1, 4) = "Earned back 0.5 pts for 30 days perfect attendance (AutoGenerated)"
Cells(LastCell, 1).Offset(1, 5) = "AUTO"
Cells(LastCell, 1).Offset(1, 0) = today
Else
End If
End Function
Sub Attendance()
Sheets("Occurences").CheckAttendance
'yes Occurences is suppose to be spelled like that (don't ask)
End Sub
edit: there are probably multiple problems with this. I fixed a lot of things, but then got stuck.
It seems that you want to parametrize your CheckAttendance routine so that it can be called on different worksheets. To do that, make it a Sub that takes a worksheet as parameter. Moreover
qualify you cells and ranges in the code
dim your variables and use Option Explicit
Option Explicit
Sub CheckAttendance(ws As Worksheet)
Dim DaysSinceOcc As Long, lastRow As Long, today As Long
lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).row
'gets current date
today = Date
'subtracts last cell in specified column from today's date.
DaysSinceOcc = today - ws.Cells(lastRow, 1).Value2
'writes what I want written in the cells I want it written in.
If DaysSinceOcc > 29 Then
ws.Cells(lastRow + 1, 1) = today
ws.Cells(lastRow + 1, 2) = "winback"
ws.Cells(lastRow + 1, 3) = -0.5
ws.Cells(lastRow + 1, 5) = "Earned back 0.5 pts for 30 days perfect attendance (AutoGenerated)"
ws.Cells(lastRow + 1, 6) = "AUTO"
End If
End Sub
Sub Attendance()
CheckAttendance Sheets("Occurences") ' <-- this is how you call it on any worksheet
End Sub
So I'm trying to make a sample selector.
The current variables I have are a range that has been specified by the user.
Settings.AmountColumn is a range that looks something along the lines of B1:H100.
SampleRefArr is an array of row numbers, relative to the first row of the Settings.AmountColumn.
For example, if my SampleRefArr shows (3,4,7) then I will need to take the following ranges (B4:H4,B5:H5,B8:H8) and copy them to a new spreadsheet. I have built the following code but that does not select the right cells...
counter = UBound(SampleRefArr, 1)
For i = 1 To counter
rowSelector = SampleRefArr(i) - Settings.AmountColumn.Cells(1, 1).Row + 2
'Settings.AmountColumn.Cells(rowSelector, 1).EntireRow.Select
Settings.AmountColumn(Cells(rowSelector, 1), Cells(rowSelector, 10)).Select
Next i
you could use this:
Sub RangeSelector(rng As Range, refArr As Variant)
Intersect(rng, rng.Range("A" & Replace(Join(refArr, ","), ",", ",A")).EntireRow.Offset(1)).Select
End Sub
to be called like:
RangeSelector Range("B1:H100"), Array(3, 4, 7)
which would return cells "B4:H5" and "B8:H8" selected
Perhaps this?
counter = UBound(SampleRefArr, 1)
For i = LBound(samplrefarr,1) To counter
With Settings.AmountColumn
rowSelector = SampleRefArr(i) - .Cells(1, 1).Row + 2
'Settings.AmountColumn.Cells(rowSelector, 1).EntireRow.Select
.Range(.Cells(rowSelector, 1), .Cells(rowSelector, 10)).Select
End With
Next i
I'm trying to use this logic:
Range(Selection, Selection.End(xlUp)).Select
In a loop string. Right now the data is create by the loop, so I'm attempting to select the row above, and all the rows for the table for that column, and add the SUM to the cell below.
I'm using a loop as the table can change depending on the reference, and when the data is received I add a new table. Everything works good up to when I want to sum a column in the table and add it below. The cell always returns a 0.
At this point
i = 6
j = 13
ws2.Cells(i , j ).Value = Application.Sum _
(Range(Cells(i, j - 1), Cells(i, j - 1).End(xlUp)))
Thanks for any advice!
Here is a technique using WorksheetFunction.Sum to create a running total.
Sub AddRunningTotal()
Const FIRST_ROW = 2
Const SOURCE_COLUMN = 11
With Worksheets("Sheet2")
With .Range(.Cells(2, SOURCE_COLUMN), .Cells(.Rows.Count, SOURCE_COLUMN).End(xlUp))
.Offset(0, 1).FormulaR1C1 = "=SUM(R2C[-1]:RC[-1])"
'Uncomment to replace the formulas with their values
'.Value = Value
End With
End With
End Sub
I am looking for a solution for the following example. I have a client who sends me a spreadsheet with 321 columns of random length. In row 2, they have a store number. For each column, there is a different store number. I need to insert a blank column in between each column and then copy the store number in the new column the same length of number of cells.
I use the following to add the columns:
Sub InsertColumns()
Dim J As Integer, k As Integer
J = Range("A1").End(xlToRight).Column
'j is the last column
For k = J To 2 Step -1
Range(Cells(1, k), Cells(1, k)).EntireColumn.Insert
Next k
I just need the code for count up base on the data in the previous column, copying the value from the previous store and pasting this in the column based on the number of rows of the previous column.
Thanks!
Joe
Sub tgr()
Dim cIndex As Long
For cIndex = Cells(2, Columns.Count).End(xlToLeft).Column To 2 Step -1
Columns(cIndex + 1).Insert
Range(Cells(1, cIndex + 1), Cells(Rows.Count, cIndex).End(xlUp).Offset(, 1)).Value = Cells(2, cIndex).Value
Next cIndex
End Sub
Try adding the following just below your posted code block:
Range(Cells(2, 1), Cells(2, (J * 2))).Copy
Range("B2").Select
ActiveSheet.PasteSpecial Format:=1, Link:=1, DisplayAsIcon:=True, IconFileName:=False
Basically it copies the second row up to the point where you have data (previous counted columns times 2 to account for the added blanks), selects the first blank cell, then does a Paste Special with the "Skip Blanks" attribute turned on.