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.
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 workbook named "2017 Time Reports", which has 12 worksheets (each one with the name of each month of the year - from "January" to "December") and a support sheet named "ListFunc". In this support sheet, I registered basic information about my co-workers (starting on row 2), as follows:
a) In the 1st column, the worker's number (variable "NFunc");
b) In the 2nd column, the worker's name (variable "Name");
c) In the 3rd column, the worker's sector (variable "CodSector") - it goes from S1 to S7;
I intend to create a program that searches subsequently for each sector code and (since I have more than one worker for each sector), it will copy the worker's number and name (associated to each individual sector code) to any given month's worksheet. It would be something like: "Search for sector S1 and, for each entry, copy the worker's number and name" then "Search for sector S2 and, for each entry, copy the worker's number and name", and so on until I reached sector S7.
I tried to investigate a little bit and came across with a couple of solutions which allowed me to mount a program that ALMOST works great. It goes as follows (for now, I'll just define the variable "CodSector", since it's the only one I need in this code):
Sub test()
Application.Workbooks("2017 Time Reports").Activate
Dim CodSector As Range
Dim copyRange As Range
Dim firstAddress As String
Dim i As Integer
Dim Row As Integer
Row = 3
Set CodSector = Worksheets("ListFunc").Range(Range("C1"), Range("C" &
Rows.Count))
'So that, if I add a new worker, it will be considered the next time I
copy the range for another monthly sheet
Dim ws, ws1 As Variant
Set ws = Worksheets("ListFunc")
Set ws1 = Worksheets(InputBox("Insert month in full"))
For i = 1 To 7
Set copyRange = CodSector.Find("S" & i, , , xlPart)
If Not copyRange Is Nothing Then
firstAddress = copyRange.Address
Do
ws1.Range(Cells(Row, 3), Cells(Row, 4)).Value =
Intersect(copyRange.EntireRow, ws.Columns("A:B")).Value
'So that the result of the intersection in ws (worksheet
"ListFunc") is pasted in the given range of ws1 (worksheet "[Month of
the year]")
Row = Row + 1
Set copyRange = CodSector.FindNext(copyRange)
Loop While copyRange.Address <> firstAddress
End If
Next i
ws1.Activate
End Sub
My problem is the following: In the expression ws1.Range(Cells(Row, 3), Cells(Row, 4)).Value = Intersect(copyRange.EntireRow, ws.Columns("A:B")).Value - If I change the beginning "ws1" for "ws" (which would mean that the result of the intersection in "ListFunc" worksheet would be pasted in the same worksheet), the code runs perfectly without any problem - but obviously that's not what I want. As it is right now, it keeps highlighting this line and giving me the following error:
Run time error '1004': Application-defined or object-defined error.
If there's someone with more expertise than me that find's out why this keeps giving this error and helps me solve it, it would be much appreciated!
Fully qualify your generic Cells references to something like this:
ws1.Range(ws1.Cells(Row, 3)
Without that, it assumes ActiveSheet which can cause problems.
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.
Please find my requirement below for which I am unable to find any solution:
1. Iterate over workSheet from workbook
2. Find all the columns containing date values using current format/type of column (Here is a trick. Worksheet is not static, it can contain any number of columns containing date values. Columns containing date values may have any name. And such worksheets can be more than one in number)
3. Apply macro on date columns for date formatting (below macro) if "Flag" value is "y"
<code>
Sub FormatDate()
If wksSecDist.Range("Flag").value = "y" Then
LastRowColA = Range("X" & Rows.Count).End(xlUp).Row
' Here I am finding total number of rows in column X
wksSecDist.Range("X2", "X" & LastRowColA).NumberFormat = "dd/mmm/yyyy"
' Here applying specified date format to Range("X2", "X10") [if last row index for column X is 10]
End If
End Sub
</code>
I am just a beginner to VBA.
Thanks in advance.
I suspect you didn't find a solution on the internet because you looked simply for a solution and not the parts needed to build your own solution.
You mention you are a VBA beginner, please take the below answer to be of educational use and begin you in getting you where you need your tool to be. Note, if it doesn't answer your question because of information that was not included, it has still answered your question and the missing information should form part of a new question. That said, lets get this function up and running.
From what you have written I have interpreted the requirement to be: -
Look over all worksheets in a workbook ('worksheets can be more than one in number')
Check every column to see if it holds a date value
If it does, set the whole column to a specific format
What is needed to accomplish this is iteration(loops), one to loop through all worksheet, and another to loop through all columns: -
The is pseudo code of the target: -
.For each Worksheet in the Workbook
..For each Column in the Worksheet
...If the Column contains dates then format it as required
..Process next column
.Process next Worksheet
We achieve this using a variable to reference a Worksheet and using a loop (For Each) to change the reference. The same goes for the columns.
Public Sub Sample()
Dim WkSht As Excel.Worksheet
Dim LngCols As Long
Dim LngCol As Long
'This loop will process the code inside it against every worksheet in this Workbook
For Each WkSht In ThisWorkbook.Worksheets
'Go to the top right of the worksheet and then come in, this finds the last used column
LngCols = WkSht.Range(WkSht.Cells(1, WkSht.Columns.Count).Address).End(xlToLeft).Column
'This loop will process the code inside it against every column in the worksheet
For LngCol = 1 To LngCols
'If the first cell contains a date then we should format the column
If IsDate(WkSht.Cells(2, LngCol)) Then
'Set right to the bottom of the sheet
WkSht.Range(WkSht.Cells(2, LngCol), WkSht.Cells(WkSht.Rows.Count, LngCol)).NumberFormat = "dd/mmm/yyyy"
End If
Next
Next
End Sub
Hopefully that has all made sense, this does work on the premise that the header row is always row 1 and there are no gaps in the columns, but these are separate issues you can approach when you're ready to.
Could someone please help me with some VBA code.
I am trying to copy 2 ranges of cells between workbooks (both workbooks should be created beforehand as i don't want the code to create a new workbook on the fly).
Firstly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell H5 to the last row in column H with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell B2 for as many cells down in the B column
Secondly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell K5 to the last row in column K with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell D2 for as many cells down in the D column
Here is what I have so far:
Sub CopyDataBetweenBooks()
Dim iRow As Long
Dim wksFr As Worksheet
Dim wksTo As Worksheet
wksFr = "C:\booka.xls"
wksTo = "C:\bookb.xls"
Set wksFrom = Workbooks(wksFr).Worksheets("Sheet 3")
Set wksTo = Workbooks(wksTo).Worksheets("Sheet 1")
With wksFrom
For iRow = 1 To 100
.Range(.Cells(iRow, 8), .Cells(iRow, 9)).Copy wksTo.Cells(iRow, 8)
Next iRow
End With
End Sub
Assuming you have the reference to wksFrom and wksTo, here is what the code should be
wksFrom.Range(wksFrom.Range("H5"), wksFrom.Range("H5").End(xlDown)).Copy wksTo.Range("B2")
wksFrom.Range(wksFrom.Range("K5"), wksFrom.Range("K5").End(xlDown)).Copy wksTo.Range("D2")
Here's an example of how to do one of the columns:
Option Explicit
Sub CopyCells()
Dim wkbkorigin As Workbook
Dim wkbkdestination As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim lastrow As Integer
Set wkbkorigin = Workbooks.Open("booka.xlsm")
Set wkbkdestination = Workbooks.Open("bookb.xlsm")
Set originsheet = wkbkorigin.Worksheets("Sheet3")
Set destsheet = wkbkdestination.Worksheets("Sheet1")
lastrow = originsheet.Range("H5").End(xlDown).Row
originsheet.Range("H5:H" & lastrow).Copy 'I corrected the ranges, as I had the src
destsheet.Range("B2:B" & (2 + lastrow)).PasteSpecial 'and destination ranges reversed
End Sub
As you have stated in the comments, this code above will not work for ranges with spaces, so substitute in the code below for the lastrow line:
lastrow = originsheet.range("H65536").End(xlUp).Row
Now ideally, you could make this into a subroutine that took in an origin workbook name, worksheet name/number, and range, as well as a destination workbook name, worksheet name/number, and range. Then you wouldn't have to repeat some of the code.
You can use special cells like Jonsca has suggested. However, I usually just loop through the cells. I find it gives me more control over what exactly I am copying. There is a very small effect on performance. However, I feel that in the office place, making sure the data is accurate and complete is the priority. I wrote a response to a question similar to this one that can be found here:
StackOverflow - Copying Cells in VBA for Beginners
There is also a small demonstration by iDevelop on how to use special cells for the same purpose. I think that it will help you. Good luck!
Update
In response to...
good start but it doesn't copy anything after the first blank cell – trunks Jun 9 '11 at 5:08
I just wanted to add that the tutorial in the link above will address the issue brought up in your comment. Instead of using the .End(xlDown) method, loop through the cells until you reach the last row, which you retrieve using .UsedRange.Rows.Count.