I would like to know if I can save a generic range, without it having a sheet name attached to it?
Lets say that my program creates a sheet for every day of the week, and then makes headings for every sheet. I want to give it a few ranges, and it must merge and add different headings to those ranges in EVERY sheet. So the headings of every sheet looks the same.
I have the following range for example:
...
Set rowTwoHeadingKiloRange = Range(Cells(2, 4), Cells(2, 8))
Set rowTwoHeadingUnitRange = Range(Cells(2, 10), Cells(2, 14))
...
Now when I try to pass this range in a dictionary to every sheet that gets created, I find that I have undesired results as some of the headings gets created on sheets where they do not belong (And I think that is because when the range is created, it attaches to the active sheet at that moment - which may be different from time to time).
So now I basically have a function that looks something like this...
Public Function colmHeadingsAndSpacing(sheetName)
With Worksheets(sheetName)
...
Set rowTwoHeadingKiloRange = Range(Cells(2, 4), Cells(2, 8))
Set rowTwoHeadingUnitRange = Range(Cells(2, 10), Cells(2, 14))
...
End with
End Function
... and I run the function every time I create a sheet, with the name of the sheet that was just created given through. But this runs the function 7 times, when I use the same data (range) every time. Also I feel that it is not working properly as well (I still get strange reactions - ranges ending up in wrong sheets).
Second question, is there a way to find out on a range, what sheet is "attached" to the range. Something like: msgbox rowTwoHeadingKiloRange.worksheets.name which will give the result of Sunday
You were close. To attach your Range and Cell to the With statement you need to use a full-stop . before the keyword. Like this:
Public Function colmHeadingsAndSpacing(sheetName)
With ThisWorkbook.Worksheets(sheetName)
...
Set rowTwoHeadingKiloRange = .Range(.Cells(2, 4), .Cells(2, 8))
Set rowTwoHeadingUnitRange = .Range(.Cells(2, 10), .Cells(2, 14))
...
End with
End Function
This is good practice to qualify every range reference with it's attached worksheet. I went one step further included a workbook reference (ThisWorkbook). Now it's fully qualified.
For the second question -- try MsgBox rowTwoHeadingKiloRange.Parent.Name to get the name of the worksheet. It's usually better to start with the worksheet name rather than work back to it though.
A range is a reference of a (mostly rectangular) area on a sheet. So referring to a range without defining a sheet like Set r = Range ("B2:F10") is exactly the same as Set r = Activeworkbook.Activesheet.Range ("B2:F10"). So for more professional purposes VBA offers you the flexibility in the following way:
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Add ' open new xlsx file
Set ws = Activesheet OR
Set ws = wb.Activesheet OR
Set ws = wb.Sheets(1)
' do something else here and later when neither wb nor ws is active, you can
Set r = wb.ws.Range("B5:G22") OR
Set r = ws.Range("B5:G22")
An addition: for producing a number of sheets of the same format, you may consider using templates either. Then you need to fill in only the differences programatically. Less programming, easier maintenance :)
Related
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 am enclosing a link with a sample spreadsheet.
What I would like to do is create multiple worksheets using the key column of "Facility", perhaps using a macro. For example, I would like to create a new worksheet called Houston and fill the worksheet with the data specific to that row. Some of the cells may end up in different locations in the new worksheet. I need to do a separate worksheet for every value in "Facility". The original that I am working on has 270 rows (270 facilities).
Does anyone have any idea how to do something like this? I am new to running and creating macros. I did create a macro that didn't work right.
Try this:
Dim wks As Worksheet
Dim lstRow As ListRow
For Each lstRow In ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1").ListRows
Set wks = ThisWorkbook.Worksheets.Add
wks.Name = lstRow.Range.Cells(, 1).Value
With wks
.Range(.Cells(1, 1), .Cells(1, lstRow.Range.Columns.Count)) = lstRow.Range.Value
End With
Next
Set wks = Nothing
Assumptions:
Worksheet name where data resides is called Sheet1
Table containing data is a ListObject (e.g., convert your data range into an Excel table)
ListObject name is Table1
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.
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.