I am very new to VBA/coding and so I'm in need of some help and so will likely be posting on here quite a bit within the next few weeks. I have been teaching myself as much as I can over the last week or so and I have decided to start a project.
I need to select and copy a table of data but the problem is the table of data changes size every single day so I cannot set a specific range. The code I am using is this but it isn't selecting the whole table.
Workbooks.open "filepath\filename.xls"
Workbooks ("filename.xls").Activate
Range ("b8").Select
Range (Selection, Selection.end(xlDown)).Select
Range (Selection, Selection.end(xlToRight)).Select
The attached picture is the table and the first cell with data in is b8(Target SLA & Category) and I want it to copy down to the bottom right of the image. as i have stated the table changes size each day so I can't have a set range. Table Data
You can select the table instead of a range of cells (change "Table1" to whatever your table is named).
ActiveSheet.ListObjects("Table1").Range.Select
Given that the overall design of your table does not change (i.e. the first observation is always in cell B8) you can use
Sub SelectData()
Dim rngData As Range
Set rngData = Worksheets("Table1").UsedRange
rngData.Offset(7, 1).Resize(rngData.Rows.Count - 7, rngData.Columns.Count - 1).Select
End Sub
In case there can be changes, the following should be quite robust:
Sub SelectData()
Dim rngData As Range
Dim intRow As Integer
Dim intColumn As Integer
intRow = Range("Table1!FirstDataPoint").Row
intColumn = Range("Table1!FirstDataPoint").Column
Set rngData = Worksheets("Table1").UsedRange
rngData.Offset(intRow - 1, intColumn - 1).Resize(rngData.Rows.Count - intRow + 1, rngData.Columns.Count - intColumn + 1).Select
End Sub
In order to apply this you have to name the upper left data point, in your case cell B8 (I used the name "FirstDataPoint"). When you insert rows or columns to the left or above of this cell the code should still work.
Related
I have two Dynamic Named Ranges - HDaCClose and HDaCReturns.
In DNR HDaCClose I have multiple columns with daily close prices of financial instruments for 100 days, thus 100 rows and X columns, see below.
For the DNR HDaCReturns I need to calculate the Natural Log of returns by using the following formula: LN = n/(n - 1). In essence I need the Natural Log of today's Closing price, divided by yesterday's closing price.
I tried to get the logic of looping trough each cell in a column and performing the calculations, before moving to the calculations for each cell in the next column.
The output that I got from it is:
Obviously inaccurate...
What should be the correct approach for a loop through each cell in each column in range HDaCReturns and perform the calculations, that I need?
I happen to know from another of your questions that you can use .FormulaR1C1 to assign the formula to the correct range of cells without need for a loop. The last row would be excluded from the output calculation as has no row to compare with.
With ThisWorkbook.Worksheets("HistoricalDataandCalculations").Range ("HDaCReturns")
.Offset(2, 1).Resize(.Rows.Count - 3, .Columns.Count - 1).FormulaR1C1 = "=LN(R[-103]C/R[-102]C)"
End With
The R[-103]C/R[-102] part of the formula references the Closed Values in the current context. You might be able to replace this with a named range reference.
A really verbose way of looking at it would be as follows, where you work with the named ranges and use a array formula (.FormulaArray) to do the calculation:
Sub AddLnCalcs()
Dim wb As Workbook
Dim ws As Worksheet
Dim returnRange As Range
Dim closeRange As Range
Dim closedRangeData As Range
Set wb = ThisWorkbook
Set ws = wb.Worksheets("HistoricalDataandCalculations")
Set returnRange = ws.Range("HDaCReturns")
Set closeRange = ws.Range("HDaCClose")
With closeRange
Set closedRangeData = .Offset(2, 1).Resize(.Rows.Count - 3, .Columns.Count - 1) '.Address 'offset 2 to avoid headers of e.g. EURUSD and close and resize to exclude headers and last row and exclude date column
End With
Dim formulaOutputArea As Range
With returnRange
Set formulaOutputArea = .Offset(2, 1).Resize(.Rows.Count - 3, .Columns.Count - 1)
formulaOutputArea.FormulaArray = "=LN(" & closedRangeData.Address & "/" & closedRangeData.Offset(1, 0).Address & ")"
End With
End Sub
I have a Macro that takes data out of 2 reports.
in the second report I have dates that I copy. I need to take a date and subtract from it 14 days
I go to first blank cell in column D, then I want to calculate the formula in column C and scroll down without type how many cells (because it is a macro to a daily basis and the amount of data will change). I want to do this until the end of the data I copied.
In the end I want to copy it as values to column B.
Here is what I have in my code(part of all macro):
'first we go to the buttom of the column
'for NOW - change manually the top of the range you paste to
'Now, paste to OP_wb workbook:
OP_wb.Sheets("Optic Main").Range("D1").End(xlDown).Offset(1, 0).PasteSpecial
Paste:=xlPasteValues
' Calculate Due Date to MFG tools
' it means date we copied from MFG daily minus 14 days
_wb.Sheets("Optic Main").Activate
Range("C1").End(xlDown).Offset(1, 0).Activate
ActiveCell.FormulaR1C1 = "=RC[1]-14"enter code here
You need to loop from the first row to the last row. In general, there are plenty of good ways to define the last row of a given column. Once you have done it, replace the value of lngEndRow and run the following code:
Option Explicit
Public Sub TestMe()
Dim lngStartRow As Long: lngStartRow = 1
Dim lngEndRow As Long: lngEndRow = 100
Dim rngMyRange As Range
Dim rngMyCell As Range
With ActiveSheet
Set rngMyRange = .Range(.Cells(lngStartRow, 5), .Cells(lngEndRow, 5))
End With
For Each rngMyCell In rngMyRange
rngMyCell.FormulaR1C1 = "=RC[1]-14"
Next rngMyCell
End Sub
Then change the ActiveSheet with the correct sheet and the column hardcoded as 5 with the correct one. Run the code above in an empty Excel, to understand what it does. Then change it a bit, until it matches your needs.
I'm trying to automate a report that for a customer and I'm a bit stuck with one of the hurdles that needs to overcome, I have some ideas but am new to VB programming.
The requirement is to copy a range of cells from one sheet to another, but the destination needs to change depending on the current date. Using a general example I'm trying to achieve the following:
If the date is the 1st of the month, the destination range is B2:F3, if it is the 2nd then the destination range is B4:F5, if the 3rd then destination is B6:F7....... if the 31st then the destination is B62:F63, the source ranges are static.
I figured I could probably achieve this by writing a huge script which contained an IF statement for each day of the month, but I was hoping I could be a bit smarter and use variables to assign the row references at the beginning of the script then just sub them back into the select/copy statements.
Absolutely you can.
Dim x as Integer
Dim daymonth as Integer
Dim rw as String
daymonth = CInt(Format(date, "d"))
x = daymonth * 2
rw = CStr(x)
Now you can use range like:
Range("D" & rw & ":F" & CStr(x + 1))
Just an example. Then since the number is constant between the two ranges just add that number to x and use it in the range.
You may want following subroutine.
Sub copyDataDependOnDatte()
Dim today As Date, dayOfToday As Integer
Dim sWS As Worksheet, dWS As Worksheet
'set two worksheets to variables
Set sWS = Worksheets("source") 'Worksheet which has data to be copied
Set dWS = Worksheets("destination") 'Worksheet which is used to record data of days.
' get day of today
today = Now() 'get date of today
dayOfToday = Day(today) ' get day of today
Range(sWS.Cells(2, 2), sWS.Cells(3, 6)).Copy 'copy B2:F3 of worksheet "source"
dWS.Cells(dayOfToday * 2, 2).PasteSpecial ' paste to worksheet "destination" at place determined by day of today
End Sub
In this code,I assumed following for writing concreat code.
"source" is name of worksheet which contains the data to be copied
"destination" is name of worksheet which records tha data copied from "source" worksheet
Data to be copied is exist at "B2:F3" of worksheet "source"
Please change worksheets' names to real names of your data.
Place of data to be copied is described as "Range(sWS.Cells(2, 2), sWS.Cells(3, 6))" in the code.
cells(2,2) means cell on 2nd row and 2nd column, i.e. "B2".
Cells(3,6) means cell on 3rd row and 6th column, i.e. "F3".
Plese correct place to fit your data.
I have already created a VBA script that is about 160 lines long, which produces the report that you see below.
Without using cell references (because the date ranges will change each time I run this) I now need to take the users ID, name, total hours, total break, overtime 1, and overtime 2 and copy this data into sheet 2.
Any suggestions as to how I can structure a VBA script to search row B until a blank is found, when a blank is found, copy the values from column J, K, L, M on that row, and on the row above copy value C - now paste these values on sheet 2. - Continue this process until you find two consecutive blanks or the end of the data...
Even if you can suggest a different way to tackle this problem than the logic I have assumed above it would be greatly appreciated. I can share the whole code if you are interested and show you the data I began with.
Thank you in advance,
J
As discussed, here's my approach. All the details are in the code's comments so make sure you read them.
Sub GetUserNameTotals()
Dim ShTarget As Worksheet: Set ShTarget = ThisWorkbook.Sheets("Sheet1")
Dim ShPaste As Worksheet: Set ShPaste = ThisWorkbook.Sheets("Sheet2")
Dim RngTarget As Range: Set RngTarget = ShTarget.UsedRange
Dim RngTargetVisible As Range, CellRef As Range, ColRef As Range, RngNames As Range
Dim ColIDIndex As Long: ColIDIndex = Application.Match("ID", RngTarget.Rows(1), 0)
Dim LRow As Long: LRow = RngTarget.SpecialCells(xlCellTypeLastCell).Row
'Turn off AutoFilter to avoid errors.
ShTarget.AutoFilterMode = False
'Logic: Apply filter on the UserName column, selecting blanks. We then get two essential ranges.
'RngTargetVisible is the visible range of stats. ColRef is the visible first column of stats.
With RngTarget
.AutoFilter Field:=ColIDIndex, Criteria1:="=", Operator:=xlFilterValues, VisibleDropDown:=True
Set RngTargetVisible = .Range("J2:M" & LRow).SpecialCells(xlCellTypeVisible)
Set ColRef = .Range("J2:J" & LRow).SpecialCells(xlCellTypeVisible)
End With
'Logic: For each cell in the first column of stats, let's get its offset one cell above
'and 7 cells to the left. This method is not necessary. Simply assigning ColRef to Column C's
'visible cells and changing below to CellRef.Offset(-1,0) is alright. I chose this way so it's
'easier to visualize the approach. RngNames is a consolidation of the cells with ranges, which we'll
'copy first before the stats.
For Each CellRef In ColRef
If RngNames Is Nothing Then
Set RngNames = CellRef.Offset(-1, -7)
Else
Set RngNames = Union(RngNames, CellRef.Offset(-1, -7))
End If
Next CellRef
'Copy the names first, then RngTargetVisible, which are the total stats. Copying headers is up
'to you. Of course, modify as necessary.
RngNames.Copy ShPaste.Range("A1")
RngTargetVisible.Copy ShPaste.Range("B1")
End Sub
Screenshots:
Set-up:
Result:
Demo video here:
Using Filters and Visible Cells
Let us know if this helps.
I'm just getting started with VBA for Excel. I used VB and Java in college nearly ten years ago and was competent with it then, but am essentially starting over. (Um, not like riding a bike.)
I am trying to understand the methods to build a range that isn't just declared as A1:J34 or whatever. My Googling is challenged in that when searching for 'range' and terms that indicate what I seek, I get an avalanche of hits far more advanced than what I need, mostly hits that don't even address the basic summary info I need.
So, here's the basics of it:
Excel 2011 on Mac.
The sheet has data from A to M, down to 1309.
It's a repeating pattern of heading rows followed by data rows. Ugh. Seems like the person creating the sheet was more thinking about printing from the sheet than the organisation of the data. I need to clean it and 3 more like it up to use in a pivot table, and it's useless in this silly repeating layout.
Heading rows are as follows:
Last Name, First Name, then 10 date cells.
Data rows under the headings are the names, of course, and then a 1 or 0 for attendance.
Anywhere from 20 to 30 names under each heading. Then it repeats. And the dates change every few sets, picking up where the last set left off.
What I need to do right now:
I'm trying to assemble a range into a range variable by adding all the rows beginning with a specific value (in column A). In my case that value is the string "Last Name", so I can have the range variable holding all the cells in all rows that begin with "Last Name". This will then capture all the cells that need to be in date format. (I'm doing it so I can then make sure the date headings are all actually IN date format - because they are NOT all in date format now, many are just 'General' cells.)
My questions:
When telling a range object what it's range IS, how do you feed it cells/rows/columns that are not just a block defined by start and end cells entered by the person writing the code but based on row criteria? Eg: Create a Range that has rows 1, 34, 70, 93, and 128 from columns A to I based on presence of "First Name" in A.
What are the most common methods to do this?
Which of these is best suited to my need and why?
Here's a working example that demonstrates finding the "Last Name" rows, contructing a range object that includes all those rows, and then iterating through that object to search for non-date values. The code could be speeded up greatly by reading the data range into an array of variants and then searching the array for both the last name rows and the "bad dates" within those rows. This is especially true if you have a very large number of rows to check.
Sub DisjointRng()
Dim checkCol As String, checkPattern As String
Dim dateCols()
Dim lastCell As Range, usedRng As Range, checkRng As Range
Dim cell As Variant
Dim usedRow As Range, resultRng As Range, rngArea As Range
Dim i As Long, j As Long
checkCol = "A" 'column to check for "Last Name"
checkPattern = "Last*"
dateCols = Array(3, 5) 'columns to check for date formatting
With Worksheets("Sheet1")
'find the bottom right corner of data range; we determine the used range
'ourselves since the built-in UsedRange is sometimes out-of-synch
Set lastCell = .Cells(.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row, _
.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column)
Set usedRng = .Range("A1:" & lastCell.Address)
'the column of values in which to look for "Last Name"
Set checkRng = .Range(checkCol & "1:" & checkCol & usedRng.Rows.Count)
End With
'step down the column of values to check for last name & add
'add found rows to range object
For Each cell In checkRng
If cell.Value Like checkPattern Then
'create a range object for the row
Set usedRow = Intersect(cell.EntireRow, usedRng)
If resultRng Is Nothing Then
'set the first row with "Last Name"
Set resultRng = usedRow
Else
'add each additional found row to the result range object
Set resultRng = Union(resultRng, usedRow)
End If
End If
Next cell
For Each rngArea In resultRng.Areas
'if found rows are continguous, Excel consolidates them
'into single area, so need to loop through each of the rows in area
For i = 1 To rngArea.Rows.Count
For j = LBound(dateCols) To UBound(dateCols)
If Not IsDate(rngArea.Cells(i, dateCols(j))) Then
'do something
End If
Next j
Next i
Next rngArea
End Sub
You can use the Union operator, like this
Dim r As Range
Set r = Range("A1, A3, A10:A12")
or this
Set r = Union(Range("A1"), Range("A3"), Range("A10:A12"))
You can the iterate this range like this
Dim cl as Range
For Each cl in r.Cells
' code cell cl
Next
or this
Dim ar as Range
For each ar in r.Areas
' code using contiguous range ar
For each cl in ar.Cells
' code using cell cl
Next
Next