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.
Related
Sub Link()
Dim Turbidity As Long
Dim RawTurbidity As Range
'Sets variables Turbidity being the ActiveCell and RawTurbidity referring to the last captured cell in raw sheets'
Turbidity = ActiveCell.Row
Set RawTurbidity = Sheets("Raw Data").Range("C4").End(xlDown)
'The formula assigning the last captured cell in Raw sheets to the active cell '
Sheet1.Range(Sheet1.Cells(Turbidity, 4), Sheet1.Cells(Turbidity, 4)).Formula = RawTurbidity
End Sub
So this is the code I have and currently it does what it's suppose to do. We have two sheets atm sheet1 and Raw Data An instrument spits out data into column C of Raw data starting wtih C4 and going all the way down. The current code I wrote in essence paste the newest value the instrument spits out to the active cell in sheet1. I have a code on Raw Data that runs the macro only when a change is made to column C4 and lower. And it works exactly how I want it to however...
my question or issue is that when I add activecell.offset(1,0).select in order to have the activecell automatically go to the next row in sheet1 without me moving the mouse the macro copies and paste the same data into the next 4 cells. If I have the intrument spit out the data again than this time it occupies the next 6 rows with the same data.
Joe B, I think you are making this harder than it is.
Last value in a sheet column gets copied to the next open row in a specified column on another sheet? Is that right?
Option Explicit
Sub Link()
Dim ws1 As Worksheet
Dim wsRaw As Worksheet
Dim ws1LastRow As Long ' "Turbidity"
Dim wsRawLastRow As Long ' "RawTurbidity"
' I suggest you just name the sheets using the developer prop window
'It cuts this whole part out as you can call them directly
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set wsRaw = ThisWorkbook.Worksheets("Raw Data")
ws1LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row 'lets say you are pasting to column A
'ws1LastRow = ws1LastRow + 1
'There you go the next writable cell row, this is wasted code though, see below you just increment when you need it
wsRawLastRow = wsRaw.Cells(wsRaw.Rows.Count, "C").End(xlUp).Row 'This method doesn't care if your data starts in C4
'No formula needed, it is a straight "copy" here, actually faster as its an assignment
ws1.Cells(ws1LastRow + 1, "A").Value = wsRaw.Cells(wsRawLastRow, "C").Value
'the next open cell (defined by row) in your sheet 1 column is equal to the last row of your Raw Data sheet column
End Sub
Issue is that the data in sheet one is not inputted in order. A person may need the data calculated to row 10 and the next calculation needs to be in row 20 hence the need to copy the data into the active cell.
This was my bad for not stating that in the initial post as it's the primary reason for this strange formula.
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 :)
I am going mad trying to do the simplest thing in VBA.
I want to automate the copying of Column C on a worksheet a variable number of times to the adjacent columns D, E, F...etc. of the same worksheet.
Stepping through the code, I have it copying the correct column ("C:C") but cannot get it to paste via Paste, Offset or Destination to column D etc. for the variable number of instances.
this is the code I'm using. Assume all the Dim and Set statements are done as it's a small part of larger Sub.
sht02AnalysisSummary.Activate
For i = 0 To AddCol
i = i + 1
lLastCol = sht02AnalysisSummary.Range("C3").End(xlToLeft).Column
rangeCopy.Copy
Column.Offset("0,lLastCol+i").Paste
Next i
sht01CoverPage.Activate
This sort of works now but with AddCol set at 3, the result is skipping Column D and only repeating the pasting once (into Column E) whereas it should be pasting into D,E & F. Any pointers will be much appreciated.
Do not manually code your iteration var in a For ... Next; you will be disrupting the built-in iteration and progression.
The xlToLeft leaves me confused about the destination (or is it source...?). Perhaps that should be xlToRight or your should start further right before starting to look to the left ?
you should be able to paste a single column into three consecutive destination columns at once.
AddCol = 3
with sht02AnalysisSummary
set rangeCopy = .range(.cells(3, "C"), .cells(.rows.count, "C").end(xlup))
rangeCopy.Copy destination:=.Cells(3, .columns.count).End(xlToLeft).resize(rangeCopy.rows.count, AddCol)
end with
This should work:
Sub CopyPaste()
Dim sht As Worksheet
Set sht = Worksheets("Sheet1")
With sht
.Columns(3).Copy .Columns(4)
End With
End Sub
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'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