Selecting multiple ranges in a macro
Greetings,
I use a speradsheet to track daily data. I have around 20 rows and a new column for each day. I want to select a row 1 cell, in today's column, and start a macro. The macro should select cells in rows 8-12 and 17-25 (just in today's column). The cells will then be copied and pasted into another sheet.
I'm struggling with this;
ActiveCell.Offset(7, 0,).Range(?:?,?:?)
The range will be different each day and how do you tell it to select 2 ranges?
I use a speradsheet to track daily data. I have around 20 rows and a new column for each day. I want to select a row 1 cell, in today's column, and start a macro. The macro should select cells in rows 8-12 and 17-25 (just in today's column). The cells will then be copied and pasted into another sheet.
I'm struggling with this;
ActiveCell.Offset(7, 0,).Range(?:?,?:?)
The range will be different each day and how do you tell it to select 2 ranges?
ASKER
Hello TigerMan,
YES my top row has dates.
I am trying to select the cells in reference to the beginning cell.
As you point out:
Range("D8:D12,D17:D25").Se
won't do that.
GR
YES my top row has dates.
I am trying to select the cells in reference to the beginning cell.
As you point out:
Range("D8:D12,D17:D25").Se
won't do that.
GR
Hi grayco
The best way to work with VBA in Excel is to try and avoid selecting cells, this way you macros will run much faster and cleaner. Most of the time there is no need to select the cells you want to work with. When copying from one sheet to another you should not have to select at all.
The macro below will.
1:Set the Variable "DestR" to become Sheets("Sheet2). this is the sheet the macro will paste to
2:Search for Todays date in the range("A1:IV1")of the Active sheet. You can change this if you wish to be any sheet. i.e Sheets("grayco").Range("A1
3:Once it has found Todays date it will set the variable "Fnd" to become the cell that has Todays date. i.e if Todays date is in Cell D1 then "Fnd" will become Range("D1")
4:As it has found Todays date it will no longer search and "Exit" the For Each loop.
5:Now it will work With "Fnd" (Cell D1) and Offset from there to the cells it has to copy.
6:Each time it copies a cell it Paste it to our Destination, which in the first instance is "DestR.Range("A2"). i.e Sheets("Sheet2").Range("A2
Hope this is clear and helps you gain some understanding of how the macro works. You will of course have to change the ranges, offsets and sheet names to suit your purposes. If you have any problems at all or are unsure about anything just yell
Sub cellselect()
'declare all Variables
Dim Rng As Range, Fnd As Range
Dim DestR As Worksheet
Set DestR = Sheets("sheet2") 'Set DestR to be Sheet2
For Each Rng In Range("A1:IV1") 'Search for Todays Date
If Date = Rng.Value Then 'Found todays date
Set Fnd = Rng 'Make Fnd the cell with todays date
Exit For 'Leave the for each loop
End If
Next
With Fnd 'The cell with Todays date
'Offset from Todays date to the cells to copy
.Offset(3, 0).Copy DestR.Range("A2") 'copy to A2 on sheet2
.Offset(5, 0).Copy DestR.Range("A3") 'copy to A3 on sheet2
.Offset(10, 0).Copy DestR.Range("A4") 'copy to A4 on sheet2
End With
End Sub
Good luck
antrat
The best way to work with VBA in Excel is to try and avoid selecting cells, this way you macros will run much faster and cleaner. Most of the time there is no need to select the cells you want to work with. When copying from one sheet to another you should not have to select at all.
The macro below will.
1:Set the Variable "DestR" to become Sheets("Sheet2). this is the sheet the macro will paste to
2:Search for Todays date in the range("A1:IV1")of the Active sheet. You can change this if you wish to be any sheet. i.e Sheets("grayco").Range("A1
3:Once it has found Todays date it will set the variable "Fnd" to become the cell that has Todays date. i.e if Todays date is in Cell D1 then "Fnd" will become Range("D1")
4:As it has found Todays date it will no longer search and "Exit" the For Each loop.
5:Now it will work With "Fnd" (Cell D1) and Offset from there to the cells it has to copy.
6:Each time it copies a cell it Paste it to our Destination, which in the first instance is "DestR.Range("A2"). i.e Sheets("Sheet2").Range("A2
Hope this is clear and helps you gain some understanding of how the macro works. You will of course have to change the ranges, offsets and sheet names to suit your purposes. If you have any problems at all or are unsure about anything just yell
Sub cellselect()
'declare all Variables
Dim Rng As Range, Fnd As Range
Dim DestR As Worksheet
Set DestR = Sheets("sheet2") 'Set DestR to be Sheet2
For Each Rng In Range("A1:IV1") 'Search for Todays Date
If Date = Rng.Value Then 'Found todays date
Set Fnd = Rng 'Make Fnd the cell with todays date
Exit For 'Leave the for each loop
End If
Next
With Fnd 'The cell with Todays date
'Offset from Todays date to the cells to copy
.Offset(3, 0).Copy DestR.Range("A2") 'copy to A2 on sheet2
.Offset(5, 0).Copy DestR.Range("A3") 'copy to A3 on sheet2
.Offset(10, 0).Copy DestR.Range("A4") 'copy to A4 on sheet2
End With
End Sub
Good luck
antrat
grayco,
Further to antrat's suggestion above, [and one day I'll learn to check more regularly], the following code will do what you wish, provided the user has the date selected in Row 1 and a macro is called:
For C = 1 To 5
Worksheets("Sheet2").Cells
= ActiveCell.Offset(6 + C, 0).Value
Next C
For C = 1 To 9
Worksheets("Sheet2").Cells
= ActiveCell.Offset(15 + C, 0).Value
Next C
End Sub
Dave
Further to antrat's suggestion above, [and one day I'll learn to check more regularly], the following code will do what you wish, provided the user has the date selected in Row 1 and a macro is called:
For C = 1 To 5
Worksheets("Sheet2").Cells
= ActiveCell.Offset(6 + C, 0).Value
Next C
For C = 1 To 9
Worksheets("Sheet2").Cells
= ActiveCell.Offset(15 + C, 0).Value
Next C
End Sub
Dave
That should be:
Sub CopyToday()
For C = 1 To 5
Worksheets("Sheet2").Cells
= ActiveCell.Offset(6 + C, 0).Value
Next C
For C = 1 To 9
Worksheets("Sheet2").Cells
= ActiveCell.Offset(15 + C, 0).Value
Next C
End Sub
Dave
Sub CopyToday()
For C = 1 To 5
Worksheets("Sheet2").Cells
= ActiveCell.Offset(6 + C, 0).Value
Next C
For C = 1 To 9
Worksheets("Sheet2").Cells
= ActiveCell.Offset(15 + C, 0).Value
Next C
End Sub
Dave
grayco - Use the Application.Union() and Application.Intersect() functions to do what you want:
Function MyRange(byval rngCol as Range) As Range
'rngCol is the range object for the column that contains the cells that you want to return from this function. E.g. Sheet2.Range("H:H") which is the same as Sheet2.Cells(1,8).EntireCo
On Error Goto MyRange_Error
With rngCol.Parent 'To return the sheet object that the column range was from
'Select all the rows that you want
Set MyRange = Application.Union(.Range(.
'Now intersect this range with the column that you want - I'm using column 2 as an example
Set MyRange = Application.Intersect(MyRa
End With
'Put your code here
MyRange_Exit:
Set MyRange = Nothing
Exit Function
MyRange_Error:
Set MyRange = Nothing
Resume MyRange_Exit
End Function
Obviously, you can concatenate the two "Set MyRange = " statements into one but I have split them up so that you can easier see what's going on.
You can also create function definition arguments (like rngCol) for the rows that you want to select.
Function MyRange(byval rngCol as Range) As Range
'rngCol is the range object for the column that contains the cells that you want to return from this function. E.g. Sheet2.Range("H:H") which is the same as Sheet2.Cells(1,8).EntireCo
On Error Goto MyRange_Error
With rngCol.Parent 'To return the sheet object that the column range was from
'Select all the rows that you want
Set MyRange = Application.Union(.Range(.
'Now intersect this range with the column that you want - I'm using column 2 as an example
Set MyRange = Application.Intersect(MyRa
End With
'Put your code here
MyRange_Exit:
Set MyRange = Nothing
Exit Function
MyRange_Error:
Set MyRange = Nothing
Resume MyRange_Exit
End Function
Obviously, you can concatenate the two "Set MyRange = " statements into one but I have split them up so that you can easier see what's going on.
You can also create function definition arguments (like rngCol) for the rows that you want to select.
Oops, where I've written:
MyRange_Exit:
Set MyRange = Nothing
Exit Function
It should read:
MyRange_Exit:
Exit Function
MyRange_Exit:
Set MyRange = Nothing
Exit Function
It should read:
MyRange_Exit:
Exit Function
ASKER
Adjusted points from 300 to 360
ASKER
Antrat,
How would you change your answer to paste the value only?
The way it is now, I'm getting formats and formulas and everything.
Thanks
Glen Ray
How would you change your answer to paste the value only?
The way it is now, I'm getting formats and formulas and everything.
Thanks
Glen Ray
ASKER
Tigerman,
Your answer does just paste values, but how do I change it to match my file?
I don't understand how yours works.
Which command is defining the cells to be copied and which command is defining the destination?
I noticed it pastes to the same cells in sheet 2 as it copied from in sheet 1.
can that be changed?
Thanks
Glen Ray
Your answer does just paste values, but how do I change it to match my file?
I don't understand how yours works.
Which command is defining the cells to be copied and which command is defining the destination?
I noticed it pastes to the same cells in sheet 2 as it copied from in sheet 1.
can that be changed?
Thanks
Glen Ray
grayco,
My answer was intended to provide an intro to copying cell values from sheet to sheet. Maybe a repaste of my answer with lots of comments:
' C is just a counter - since you have 5 values in the first range it is set to 5
For C = 1 To 5
Worksheets("Sheet2").Cells
= ActiveCell.Offset(6 + C, 0).Value
WS(Sheet2) is clearly your other sheet (the destination). Cells(ActiveCellRow + C + 6, ActiveCell,Column) is the same as: On the other sheet, point to the row that is the equivalent of the active cell on Sh1 (that is Row 1, since the date heading is selected) add 6 (to start on Row 6) then add C (which changes through the loop, but starts at 1) so for the first time through the loop it starts at Sh2(Row 7) which matches the source (Sh1 Row). Further the column is the same since ActiveCell.Column is the column that the user has selected with the date in it. So you can easily modify the Sh2 pointers by changing the 6 - if you wish to send the data starting at row 2 on Sh2, then change the 6 to a 1.
The other half of the assignment simply reads through each of the 5 values that you have in Sh1, starting at: ActiveCell.Offset(6+C,0) which simply sends the pointer down Sh1 to the first of your data values, then increments it for each of the other 4 with the change to C.
Next C
And of course the looping statement to ensure that the assignment occurs 5 times.
There would be nothing wrong with changing the assignment statements to point to a certain and fixed range of cells on your destination sheet. Of course you will need a mechanism to work out which sheet to copy to. MsgBox would probably be the way to go.
Hope that helps explain.
You should note that this method is not generic (as the others are). It is not transferrable, and has its own little internal problems - but it should give you a feel for assigning without selection.
Dave
My answer was intended to provide an intro to copying cell values from sheet to sheet. Maybe a repaste of my answer with lots of comments:
' C is just a counter - since you have 5 values in the first range it is set to 5
For C = 1 To 5
Worksheets("Sheet2").Cells
= ActiveCell.Offset(6 + C, 0).Value
WS(Sheet2) is clearly your other sheet (the destination). Cells(ActiveCellRow + C + 6, ActiveCell,Column) is the same as: On the other sheet, point to the row that is the equivalent of the active cell on Sh1 (that is Row 1, since the date heading is selected) add 6 (to start on Row 6) then add C (which changes through the loop, but starts at 1) so for the first time through the loop it starts at Sh2(Row 7) which matches the source (Sh1 Row). Further the column is the same since ActiveCell.Column is the column that the user has selected with the date in it. So you can easily modify the Sh2 pointers by changing the 6 - if you wish to send the data starting at row 2 on Sh2, then change the 6 to a 1.
The other half of the assignment simply reads through each of the 5 values that you have in Sh1, starting at: ActiveCell.Offset(6+C,0) which simply sends the pointer down Sh1 to the first of your data values, then increments it for each of the other 4 with the change to C.
Next C
And of course the looping statement to ensure that the assignment occurs 5 times.
There would be nothing wrong with changing the assignment statements to point to a certain and fixed range of cells on your destination sheet. Of course you will need a mechanism to work out which sheet to copy to. MsgBox would probably be the way to go.
Hope that helps explain.
You should note that this method is not generic (as the others are). It is not transferrable, and has its own little internal problems - but it should give you a feel for assigning without selection.
Dave
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
What about my comment? :-) . Even by looking at Antrat's and Tigerman's solutions, I'm not sure how you want the cells you selected pasted into the other sheet. I.e.:
1. Do you want them in one column only (e.g. column 2) of the Destination sheet at all times?
2. Do you want the values in continuous rows (even though they are from separate rows in the source sheet)?
3. Or do you want them pasting into the same cells?
4. Are the rows in the source sheet where you are selecting the rows (i.e. rows 8-12 and 17-25) going to be constant? If not, what are your criteria?
If you provide the above answers, I can create a generic solution for you whereby you aren't limited to hard-coding the row quantities etc. into your code (never a good idea). Antrat's and Tigerman's solutions both use hard-coding - although they do give you an idea of how to perform your function. However, I think for the points that you are posting, you want a more generic and complete solution that you can maybe use elsewhere in the future. Then again, maybe not.... :-)
I'll await your response :-) .
1. Do you want them in one column only (e.g. column 2) of the Destination sheet at all times?
2. Do you want the values in continuous rows (even though they are from separate rows in the source sheet)?
3. Or do you want them pasting into the same cells?
4. Are the rows in the source sheet where you are selecting the rows (i.e. rows 8-12 and 17-25) going to be constant? If not, what are your criteria?
If you provide the above answers, I can create a generic solution for you whereby you aren't limited to hard-coding the row quantities etc. into your code (never a good idea). Antrat's and Tigerman's solutions both use hard-coding - although they do give you an idea of how to perform your function. However, I think for the points that you are posting, you want a more generic and complete solution that you can maybe use elsewhere in the future. Then again, maybe not.... :-)
I'll await your response :-) .
Hi, I'm waiting too :-)
ASKER
Adjusted points from 360 to 400
ASKER
Noggy, calacuccia, antrat, Tigerman,
Here's the whole thing.
Each day I record 8 chemical tank levels, in one column. They are in rows 3-10. In rows 12-19 the tank levels are converted to gallons. Between there and row 70 I have information like Daily usage, 7 day average usage, YTD usage, Chemicals added and in rows 63-70 I have a 7day average of the 7day average usage.
In sheet2 (named "Estimated Usage"), I use the gallons in rows 12-19 and the averages in rows 63-70 to forcast the next eight days chemical usage.
I have been manually highlighting these rows and running a macro to paste them into "Estimated Usage" b2 -b17. The macro also puts the next eight days dates across row one. Simple formulas subtract the average usage from the gallons and conditional formatting highlight chemicals that will need reordering within the next eight days.
Antrat solution works. I am however interested in other solutions that as Noggy said "that you can maybe use elsewhere in the future"
Thanks All for your interest
Here's the whole thing.
Each day I record 8 chemical tank levels, in one column. They are in rows 3-10. In rows 12-19 the tank levels are converted to gallons. Between there and row 70 I have information like Daily usage, 7 day average usage, YTD usage, Chemicals added and in rows 63-70 I have a 7day average of the 7day average usage.
In sheet2 (named "Estimated Usage"), I use the gallons in rows 12-19 and the averages in rows 63-70 to forcast the next eight days chemical usage.
I have been manually highlighting these rows and running a macro to paste them into "Estimated Usage" b2 -b17. The macro also puts the next eight days dates across row one. Simple formulas subtract the average usage from the gallons and conditional formatting highlight chemicals that will need reordering within the next eight days.
Antrat solution works. I am however interested in other solutions that as Noggy said "that you can maybe use elsewhere in the future"
Thanks All for your interest
Oh dear, cal's got a 90 minute head start on me. I've only just read your comments, grayco. Let's just hope that cal doesn't post an answer while I'm creating one :-) . Or antrat or the others for that matter....
grayco,
From what you have written above, the solution that I provided is well suited - since it is a 1-off each day.
Could you reply with the range of the destination cells in Estimated Usage".
Once I have that I can reply with the same 'modified' two assignment statements.
Can't do for about 2 hours though - taking my 6yo to movies. See you soon.
Dave
From what you have written above, the solution that I provided is well suited - since it is a 1-off each day.
Could you reply with the range of the destination cells in Estimated Usage".
Once I have that I can reply with the same 'modified' two assignment statements.
Can't do for about 2 hours though - taking my 6yo to movies. See you soon.
Dave
grayco,
From what you have written above, the solution that I provided is well suited - since it is a 1-off each day.
Could you reply with the range of the destination cells in Estimated Usage".
Once I have that I can reply with the same 'modified' two assignment statements.
Can't do for about 2 hours though - taking my 6yo to movies. See you soon.
Dave
From what you have written above, the solution that I provided is well suited - since it is a 1-off each day.
Could you reply with the range of the destination cells in Estimated Usage".
Once I have that I can reply with the same 'modified' two assignment statements.
Can't do for about 2 hours though - taking my 6yo to movies. See you soon.
Dave
grayco,
I got back before you replied. Try this:
Sub CopyToday()
For c = 1 To 5
Worksheets("Estimated Usage").Cells(c, 1).Value = ActiveCell.Offset(6 + c, 0).Value
Next c
For c = 1 To 9
Worksheets("Estimated Usage").Cells(c + 8, 1).Value = ActiveCell.Offset(10 + c, 1).Value
Next c
End Sub
This will pick up the values in the selected column and place 8 to 12 and 17 to 25 into column 1 in your Estimated Usage sheet.
To change the locations in Estimated Usage, just change the WorkSheets("Estimated Usage").Cells Row/Col values.
Dave
I got back before you replied. Try this:
Sub CopyToday()
For c = 1 To 5
Worksheets("Estimated Usage").Cells(c, 1).Value = ActiveCell.Offset(6 + c, 0).Value
Next c
For c = 1 To 9
Worksheets("Estimated Usage").Cells(c + 8, 1).Value = ActiveCell.Offset(10 + c, 1).Value
Next c
End Sub
This will pick up the values in the selected column and place 8 to 12 and 17 to 25 into column 1 in your Estimated Usage sheet.
To change the locations in Estimated Usage, just change the WorkSheets("Estimated Usage").Cells Row/Col values.
Dave
For example, to copy to column 2 of Estimated Usage:
Sub CopyToday()
For c = 1 To 5
Worksheets("Estimated Usage").Cells(c, 2).Value _
= ActiveCell.Offset(6 + c, 0).Value
Next c
For c = 1 To 9
Worksheets("Estimated Usage").Cells(c + 8, 2).Value _
= ActiveCell.Offset(10 + c, 1).Value
Next c
End Sub
And to copy all to 1 row lower, try:
Sub CopyToday()
For c = 1 To 5
Worksheets("Estimated Usage").Cells(c + 1, 2).Value _
= ActiveCell.Offset(6 + c, 0).Value
Next c
For c = 1 To 9
Worksheets("Estimated Usage").Cells(c + 9, 2).Value _
= ActiveCell.Offset(10 + c, 1).Value
Next c
End Sub
Dave
Sub CopyToday()
For c = 1 To 5
Worksheets("Estimated Usage").Cells(c, 2).Value _
= ActiveCell.Offset(6 + c, 0).Value
Next c
For c = 1 To 9
Worksheets("Estimated Usage").Cells(c + 8, 2).Value _
= ActiveCell.Offset(10 + c, 1).Value
Next c
End Sub
And to copy all to 1 row lower, try:
Sub CopyToday()
For c = 1 To 5
Worksheets("Estimated Usage").Cells(c + 1, 2).Value _
= ActiveCell.Offset(6 + c, 0).Value
Next c
For c = 1 To 9
Worksheets("Estimated Usage").Cells(c + 9, 2).Value _
= ActiveCell.Offset(10 + c, 1).Value
Next c
End Sub
Dave
I can say that again!
Hi grayco
I'm glad my first solution suited your needs.
I have now also written a more "Generic" solution that can be 2 non ajoining ranges.
The first input box will ask you to type in the ranges of the cells you wish to copy that are under todays date .It is important that each range is typed as shown e.g 12:20,30:52
The second Input box will ask for the cell number to paste to on Sheet "Estimated Usage" again it is important to type as shown e.g 1,2 will be A2.
I have called your first sheet "Daily Usage" and the second sheet Estimated Usage" you can change these if needed.
Sub RowSelector()
'declare all Variables
Dim Rng As Range, Fnd As Range
Dim Rng1 As String, Rng2 As String, rws As String
Dim Rws2 As String
Dim DestSht As Worksheet, CpySht As Worksheet
Dim ColN As Integer
Dim DestR1 As Integer, DestR2 As Integer
Set CpySht = Sheets("Daily Usage") 'Set CpySht to be Sheet1
Set DestSht = Sheets("Estimated Usage") 'Set DestSht to be Sheet2
For Each Rng In CpySht.Range("A1:IV1") 'Search for Todays Date
If Date = Rng.Value Then 'Found todays date
Set Fnd = Rng 'Make Fnd the col with todays date
ColN = Rng.Column
Exit For 'Leave the for each loop
End If
Next
'START OF COPY RANGE
rws = InputBox("Enter Copy Range as rows i.e 12:19,63:70", _
"COPY RANGE", "12:19,63:70")
If rws <> "" Then
Rng1 = WorksheetFunction.Replace(
(",", rws), 8, "")
Rng2 = WorksheetFunction.Replace(
'START OF destination RANGE
Rws2 = InputBox("Enter Row and column number i.e '2,2 will =B2", _
"COPY RANGE", "2,2")
If Rws2 <> "" Then
DestR1 = WorksheetFunction.Replace(
(",", Rws2), 8, "")
DestR2 = WorksheetFunction.Replace(
(",", Rws2), Len(DestR1) + 1, "")
Union(Range(Rng1).Columns(
DestSht.Cells(DestR1, DestR2.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End If
End If
End Sub
Have fun
antrat
I'm glad my first solution suited your needs.
I have now also written a more "Generic" solution that can be 2 non ajoining ranges.
The first input box will ask you to type in the ranges of the cells you wish to copy that are under todays date .It is important that each range is typed as shown e.g 12:20,30:52
The second Input box will ask for the cell number to paste to on Sheet "Estimated Usage" again it is important to type as shown e.g 1,2 will be A2.
I have called your first sheet "Daily Usage" and the second sheet Estimated Usage" you can change these if needed.
Sub RowSelector()
'declare all Variables
Dim Rng As Range, Fnd As Range
Dim Rng1 As String, Rng2 As String, rws As String
Dim Rws2 As String
Dim DestSht As Worksheet, CpySht As Worksheet
Dim ColN As Integer
Dim DestR1 As Integer, DestR2 As Integer
Set CpySht = Sheets("Daily Usage") 'Set CpySht to be Sheet1
Set DestSht = Sheets("Estimated Usage") 'Set DestSht to be Sheet2
For Each Rng In CpySht.Range("A1:IV1") 'Search for Todays Date
If Date = Rng.Value Then 'Found todays date
Set Fnd = Rng 'Make Fnd the col with todays date
ColN = Rng.Column
Exit For 'Leave the for each loop
End If
Next
'START OF COPY RANGE
rws = InputBox("Enter Copy Range as rows i.e 12:19,63:70", _
"COPY RANGE", "12:19,63:70")
If rws <> "" Then
Rng1 = WorksheetFunction.Replace(
(",", rws), 8, "")
Rng2 = WorksheetFunction.Replace(
'START OF destination RANGE
Rws2 = InputBox("Enter Row and column number i.e '2,2 will =B2", _
"COPY RANGE", "2,2")
If Rws2 <> "" Then
DestR1 = WorksheetFunction.Replace(
(",", Rws2), 8, "")
DestR2 = WorksheetFunction.Replace(
(",", Rws2), Len(DestR1) + 1, "")
Union(Range(Rng1).Columns(
DestSht.Cells(DestR1, DestR2.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End If
End If
End Sub
Have fun
antrat
grayco - Sorry about the delay; I was out on the piss last night. Got dragged out by friends - you know how it is :-) .
Well, here's a solution for you. You will see that there is generic code in there. The main function is in the procedure called...err...Main(). All the rest of the functions are generic that you may be able to use elsewhere.
There is no getting away from a bit of hardcoding so all of it is in this procedure. The hardcoding is minimised by using range names (the range name assumptions are included as comments in the code for Main()) for anything that would normally be hardcoded.
This way, inserting a new row or column in any of the ranges will be taken care of automatically by the macro and will not require changing the macro (unless you add another separate range that you want to copy).
So here's my solution. I have commented as much as possible so that it's easier for you to understand. However, if you have any questions, don't hesitate to call.
Public Sub Main()
Dim cellTankLevelDate As Range
Dim rngToCopy As Range
On Error GoTo Main_Error
'First determine where your date cell is in Tank Levels sheet.
'We shall assume that you have the range named as "TankLevelDates"
'so now, we can refer to it in code as [TankLevelDates].
'NB I've used the .EntireRow in the next line just in case your range name does not cover the entire row
Set cellTankLevelDate = FindDateCell(Date, [TankLevelDates].EntireRow
If cellTankLevelDate Is Nothing Then
MsgBox "No date could be found."
Error 3000
End If
'You may want to add more dates to the date row in your Tank Level sheet too
AddConsecutiveDates cellTankLevelDate, True, 8
'Similar to before, let us assume that you have your Tank Levels In Gallons (rows 12-19)
'and your 7 Day Average (rows 63-70) ranges named as
'"TankLevelsInGallons" and "Average7Day" respectively.
'Collect all the rows which contain data that we want to copy
'NB Again, I have used .EntireRow to ensure that we have the entirerow
Set rngToCopy = Application.Union([TankLev
'And now refine the selection so that we only have the corresponding cells for today.
Set rngToCopy = Application.Intersect(rngT
'Copy the ranges to your destination sheet.
'I will assume that you have named the start cell in your destination sheet as "EstimatedUsageStartCell"
If Not (CopyRanges(rngToCopy, [EstimatedUsageStartCell],
'There was a problem in the copy.
'The message box for this would have been reported in the CopyRanges() function.
End If
'Now we want to refresh your dates in the "Estimated Usage" sheet
With [EstimatedUsageStartCell].
.Value = Date
AddConsecutiveDates .Cells(1), True, 8
End With
'And that's it :-) .
Main_Exit:
Exit Sub
Main_Error:
ShowError "MyModuleName", "Main"
Resume Main_Exit
End Sub
Public Function FindDateCell(ByVal ContainingDate As Date, ByVal SearchRange As Range) As Range
On Error GoTo FindDateCell_Error
Set FindDateCell = SearchRange.Find(Containin
FindDateCell_Exit:
Exit Function
FindDateCell_Error:
Set FindDateCell = Nothing
Resume FindDateCell_Exit
End Function
Public Function AddConsecutiveDates(ByVal AfterDateCell As Range, ByVal AlongRow As Boolean, ByVal QtyToAdd As Long) As Boolean
On Error GoTo AddConsecutiveDates_Error
'Assume that the function will be successful
AddConsecutiveDates = True
With AfterDateCell
Select Case AlongRow
Case True
'We want to add more dates along the row directly to the right of AfterDateCell
.AutoFill .Resize(1, QtyToAdd), xlFillDays
Case False
'We want to add more dates down the column directly below AfterDateCell
.AutoFill .Resize(QtyToAdd, 1), xlFillDays
End Select
End With
AddConsecutiveDates_Exit:
Exit Function
AddConsecutiveDates_Error:
AddConsecutiveDates = False
Resume AddConsecutiveDates_Exit
End Function
'ByVal rngToCopy As Range - The range of cells that we want to copy. May consist of non-contiguous areas.
' NB It will also cope happily with different areas in the range with multiple rows and columns.
'ByVal cellDestination As Range - The first (top-left) cell where the data is to copied to.
' If more than one cell is passed, the top-left cell will be assumed.
'Optional ByVal PasteOnlyValues As Boolean - True=We only want to paste the values
' False (Default) = We want to paste all values, formats, borders etc..
'Optional ByVal AsContinuousRange As Boolean - True=To remove gaps between areas in rngToCopy
' False (Default)=To include the gaps
'Optional ByVal AcrossRow As Boolean - Only used if AsContinuousRange is used.
' True=Put the separate areas in sequential columns
' False (Default)=Put the separate areas in sequential rows
Public Function CopyRanges(ByVal rngToCopy As Range, ByVal cellDestination As Range, _
Optional ByVal PasteOnlyValues As Boolean, _
Optional ByVal AsContinuousRange As Boolean, Optional ByVal AcrossRow As Boolean) As Boolean
Dim rngArea As Range
On Error GoTo CopyRanges_Error
'Assume that the function will be successful
CopyRanges = True
'Check that we have at least something to copy.
If rngToCopy Is Nothing Then
MsgBox "There is nothing to copy."
Error 3000
End If
'Ensure that we only have the one destination cell where we are copying the data to.
'Assume that this will be the first cell in the range.
'This will prevent any range size mismatch errors.
Set cellDestination = cellDestination.Cells(1)
'Start copying the range
Select Case AsContinuousRange
Case False
'This is the simplest option: we don't care about the gaps.
Select Case PasteOnlyValues
Case True
rngToCopy.Copy
cellDestination.PasteSpeci
Case False
rngToCopy.Copy cellDestination
End Select
Case True
'We want to remove any gaps. So we'll need to look at each range area in turn.
For Each rngArea In rngToCopy.Areas
'Copy the area to the destination cell
Select Case PasteOnlyValues
Case True
rngArea.Copy
cellDestination.PasteSpeci
Case False
rngArea.Copy cellDestination
End Select
'Now we need to determine where the next area is to copied to
Select Case AcrossRow
Case True
Set cellDestination = cellDestination.Offset(0, rngArea.Columns.Count)
Case False
Set cellDestination = cellDestination.Offset(rng
End Select
Next rngArea
End Select
CopyRanges_Exit:
Application.CutCopyMode = False
Set rngArea = Nothing
Exit Function
CopyRanges_Error:
ShowError "MyModuleName", "CopyRanges"
MsgBox "There was a problem in the copy from sheet [" & rngToCopy.Parent.Name & "]" & vbCr & _
"to sheet [" & cellDestination.Parent.Nam
CopyRanges = False
Resume CopyRanges_Exit
End Function
You will notice that I have included a reference to a procedure called ShowError in my error trapping routine. As a freebie, I will include it below. When an error is found, the following is generated:
1. A dialogue for the user so that they can see there was an error (and who to contact).
2. The error is appended to an error log file which the function will automatically create in the same directory as your workbook.
3. It tags the error with the user's login name and date that the error was found too.
4. And with the Module and procedure name where it occurred.
[5. You may also notice that there is REMmed out code in there for a similar function for MS Access too]
The only exception to the above is that Error 3000 is one that I raise myself when I want to abort a procedure prematurely. This error will not be logged. It is simply there so that the procedure can be exited safely by always ensuring that the procedure_exit routine in each procedure is executed.
One of the arguments (the first) for ShowError is the name of the module. I have used "MyModuleName" but it would be best if you changed this to the name of your module.
Here is the code for this error routine. Note that the first bit is an API declaration. So you will need to put this in the General Declarations section at the top of your module.
Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _
As Long
'*************************
'What: Displays the Error that was unexpected. It also logs it in a .DAT file in the same directory as the database
' and in a table within the database itself.
'Author: Robin 'Nog' Davis
'Created: 12/04/1999
'Revised by: -
'When: -
'Passed In: ByVal sModule As String - The module name where the Error occurred
' ByVal sProc As String - The procedure that raised the Error
'Returns: -
'Called By: Every procedure with more than 4 lines
'Calls: -
'*************************
Public Sub ShowError(ByVal sModule As String, ByVal sProc As String)
Dim sErrorFile As String
Dim vbComma As String
Dim errNumber As Long
Dim errDescr As String
Dim errSource As String
' Dim rs As Recordset
Select Case Err.Number
Case 3000
'General Error that is expected and is used so that the calling procedure can be exited safely using the ****_Exit: label
Case Else
vbComma = Chr(44)
'We need to record the error properties as we may experience problems writing the Log file
errNumber = Err.Number
errDescr = Err.Description
errSource = Err.Source
'We want to record the Error and also write the Error into an Error file
'Determine the name of the Error File
sErrorFile = ThisWorkbook.FullName
sErrorFile = Left(sErrorFile, Len(sErrorFile) - 4) & " Error.log"
'Write the Error into the Error file
On Error Resume Next
Open sErrorFile For Append As #2
Print #2, CurrentUser(); vbComma; Date; vbComma; Time; vbComma; sModule; vbComma; sProc; vbComma; errNumber; vbComma; errDescr; vbComma; Application.StatusBar
Close #2
'And record it within this database too
' Set rs = CurrentDb.OpenRecordset(st
' With rs
' .AddNew
' ![Date] = Now()
' ![Module] = sModule
' ![Procedure] = sProc
' ![ErrorNumber] = Err.Number
' ![ErrorDescription] = Err.Description
' ![User] = CurrentUser()
' .Update
' End With
' Set rs = Nothing
' iAns = MsgBox("Error: " & sError & Chr(10) & "Continue? ", 276, "Error occurred! Action Required")
' If iAns = 6 Then
' 'GetLogonName
' showError = True
' Else
' DoCmd.Quit
' End If
MsgBox "Please note the following message:" & vbCr & _
"'" & errDescr & "'" & vbCr & vbCr & _
"Current Operation: " & Application.StatusBar & vbCr & _
"This was located in: " & vbCr & _
vbTab & "VB Module: " & vbTab & sModule & vbCr & _
vbTab & "Procedure: " & vbTab & sProc & vbCr & _
"Contact <<your Helpdesk>> for support.", _
vbOKOnly + vbExclamation, _
"" & errSource & ": Error " & errNumber '& "-" & Error(Err.Number)
End Select
End Sub
'*************************
'What: Returns the current user that is logged into either Windows95/NT (and I suspect Windows98 as well)
' NB DO NOT USER ErrOR HANDLING IN THIS ROUTINE AS IT WILL RESET Err WHEN CALLED BY SHOWErrOR()
'Author: Robin 'Nog' Davis
'Created: 22/04/99 10:43:21
'Revised By: -
'When: -
'Parameters: -
'Returns: -
'Called By: -
'Calls: -
'*************************
Public Function CurrentUser() As String
Dim s As String
Dim cnt As Long
Dim dl As Long
Dim CurUser As String
'On Error GoTo CurrentUser_Error
cnt = 199
s = String$(200, 0)
dl = GetUserName(s, cnt)
If dl <> 0 Then
CurrentUser = Left$(s, cnt - 1)
Else
CurrentUser = ""
End If
CurrentUser_Exit:
Exit Function
CurrentUser_Error:
' *****************
' The following section is only used for debugging
'Stop: Resume
' *****************
' ShowError "zvbFunctions", "CurrentUser"
' CurrentUser = ""
' Resume CurrentUser_Exit
End Function
Well, here's a solution for you. You will see that there is generic code in there. The main function is in the procedure called...err...Main(). All the rest of the functions are generic that you may be able to use elsewhere.
There is no getting away from a bit of hardcoding so all of it is in this procedure. The hardcoding is minimised by using range names (the range name assumptions are included as comments in the code for Main()) for anything that would normally be hardcoded.
This way, inserting a new row or column in any of the ranges will be taken care of automatically by the macro and will not require changing the macro (unless you add another separate range that you want to copy).
So here's my solution. I have commented as much as possible so that it's easier for you to understand. However, if you have any questions, don't hesitate to call.
Public Sub Main()
Dim cellTankLevelDate As Range
Dim rngToCopy As Range
On Error GoTo Main_Error
'First determine where your date cell is in Tank Levels sheet.
'We shall assume that you have the range named as "TankLevelDates"
'so now, we can refer to it in code as [TankLevelDates].
'NB I've used the .EntireRow in the next line just in case your range name does not cover the entire row
Set cellTankLevelDate = FindDateCell(Date, [TankLevelDates].EntireRow
If cellTankLevelDate Is Nothing Then
MsgBox "No date could be found."
Error 3000
End If
'You may want to add more dates to the date row in your Tank Level sheet too
AddConsecutiveDates cellTankLevelDate, True, 8
'Similar to before, let us assume that you have your Tank Levels In Gallons (rows 12-19)
'and your 7 Day Average (rows 63-70) ranges named as
'"TankLevelsInGallons" and "Average7Day" respectively.
'Collect all the rows which contain data that we want to copy
'NB Again, I have used .EntireRow to ensure that we have the entirerow
Set rngToCopy = Application.Union([TankLev
'And now refine the selection so that we only have the corresponding cells for today.
Set rngToCopy = Application.Intersect(rngT
'Copy the ranges to your destination sheet.
'I will assume that you have named the start cell in your destination sheet as "EstimatedUsageStartCell"
If Not (CopyRanges(rngToCopy, [EstimatedUsageStartCell],
'There was a problem in the copy.
'The message box for this would have been reported in the CopyRanges() function.
End If
'Now we want to refresh your dates in the "Estimated Usage" sheet
With [EstimatedUsageStartCell].
.Value = Date
AddConsecutiveDates .Cells(1), True, 8
End With
'And that's it :-) .
Main_Exit:
Exit Sub
Main_Error:
ShowError "MyModuleName", "Main"
Resume Main_Exit
End Sub
Public Function FindDateCell(ByVal ContainingDate As Date, ByVal SearchRange As Range) As Range
On Error GoTo FindDateCell_Error
Set FindDateCell = SearchRange.Find(Containin
FindDateCell_Exit:
Exit Function
FindDateCell_Error:
Set FindDateCell = Nothing
Resume FindDateCell_Exit
End Function
Public Function AddConsecutiveDates(ByVal AfterDateCell As Range, ByVal AlongRow As Boolean, ByVal QtyToAdd As Long) As Boolean
On Error GoTo AddConsecutiveDates_Error
'Assume that the function will be successful
AddConsecutiveDates = True
With AfterDateCell
Select Case AlongRow
Case True
'We want to add more dates along the row directly to the right of AfterDateCell
.AutoFill .Resize(1, QtyToAdd), xlFillDays
Case False
'We want to add more dates down the column directly below AfterDateCell
.AutoFill .Resize(QtyToAdd, 1), xlFillDays
End Select
End With
AddConsecutiveDates_Exit:
Exit Function
AddConsecutiveDates_Error:
AddConsecutiveDates = False
Resume AddConsecutiveDates_Exit
End Function
'ByVal rngToCopy As Range - The range of cells that we want to copy. May consist of non-contiguous areas.
' NB It will also cope happily with different areas in the range with multiple rows and columns.
'ByVal cellDestination As Range - The first (top-left) cell where the data is to copied to.
' If more than one cell is passed, the top-left cell will be assumed.
'Optional ByVal PasteOnlyValues As Boolean - True=We only want to paste the values
' False (Default) = We want to paste all values, formats, borders etc..
'Optional ByVal AsContinuousRange As Boolean - True=To remove gaps between areas in rngToCopy
' False (Default)=To include the gaps
'Optional ByVal AcrossRow As Boolean - Only used if AsContinuousRange is used.
' True=Put the separate areas in sequential columns
' False (Default)=Put the separate areas in sequential rows
Public Function CopyRanges(ByVal rngToCopy As Range, ByVal cellDestination As Range, _
Optional ByVal PasteOnlyValues As Boolean, _
Optional ByVal AsContinuousRange As Boolean, Optional ByVal AcrossRow As Boolean) As Boolean
Dim rngArea As Range
On Error GoTo CopyRanges_Error
'Assume that the function will be successful
CopyRanges = True
'Check that we have at least something to copy.
If rngToCopy Is Nothing Then
MsgBox "There is nothing to copy."
Error 3000
End If
'Ensure that we only have the one destination cell where we are copying the data to.
'Assume that this will be the first cell in the range.
'This will prevent any range size mismatch errors.
Set cellDestination = cellDestination.Cells(1)
'Start copying the range
Select Case AsContinuousRange
Case False
'This is the simplest option: we don't care about the gaps.
Select Case PasteOnlyValues
Case True
rngToCopy.Copy
cellDestination.PasteSpeci
Case False
rngToCopy.Copy cellDestination
End Select
Case True
'We want to remove any gaps. So we'll need to look at each range area in turn.
For Each rngArea In rngToCopy.Areas
'Copy the area to the destination cell
Select Case PasteOnlyValues
Case True
rngArea.Copy
cellDestination.PasteSpeci
Case False
rngArea.Copy cellDestination
End Select
'Now we need to determine where the next area is to copied to
Select Case AcrossRow
Case True
Set cellDestination = cellDestination.Offset(0, rngArea.Columns.Count)
Case False
Set cellDestination = cellDestination.Offset(rng
End Select
Next rngArea
End Select
CopyRanges_Exit:
Application.CutCopyMode = False
Set rngArea = Nothing
Exit Function
CopyRanges_Error:
ShowError "MyModuleName", "CopyRanges"
MsgBox "There was a problem in the copy from sheet [" & rngToCopy.Parent.Name & "]" & vbCr & _
"to sheet [" & cellDestination.Parent.Nam
CopyRanges = False
Resume CopyRanges_Exit
End Function
You will notice that I have included a reference to a procedure called ShowError in my error trapping routine. As a freebie, I will include it below. When an error is found, the following is generated:
1. A dialogue for the user so that they can see there was an error (and who to contact).
2. The error is appended to an error log file which the function will automatically create in the same directory as your workbook.
3. It tags the error with the user's login name and date that the error was found too.
4. And with the Module and procedure name where it occurred.
[5. You may also notice that there is REMmed out code in there for a similar function for MS Access too]
The only exception to the above is that Error 3000 is one that I raise myself when I want to abort a procedure prematurely. This error will not be logged. It is simply there so that the procedure can be exited safely by always ensuring that the procedure_exit routine in each procedure is executed.
One of the arguments (the first) for ShowError is the name of the module. I have used "MyModuleName" but it would be best if you changed this to the name of your module.
Here is the code for this error routine. Note that the first bit is an API declaration. So you will need to put this in the General Declarations section at the top of your module.
Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _
As Long
'*************************
'What: Displays the Error that was unexpected. It also logs it in a .DAT file in the same directory as the database
' and in a table within the database itself.
'Author: Robin 'Nog' Davis
'Created: 12/04/1999
'Revised by: -
'When: -
'Passed In: ByVal sModule As String - The module name where the Error occurred
' ByVal sProc As String - The procedure that raised the Error
'Returns: -
'Called By: Every procedure with more than 4 lines
'Calls: -
'*************************
Public Sub ShowError(ByVal sModule As String, ByVal sProc As String)
Dim sErrorFile As String
Dim vbComma As String
Dim errNumber As Long
Dim errDescr As String
Dim errSource As String
' Dim rs As Recordset
Select Case Err.Number
Case 3000
'General Error that is expected and is used so that the calling procedure can be exited safely using the ****_Exit: label
Case Else
vbComma = Chr(44)
'We need to record the error properties as we may experience problems writing the Log file
errNumber = Err.Number
errDescr = Err.Description
errSource = Err.Source
'We want to record the Error and also write the Error into an Error file
'Determine the name of the Error File
sErrorFile = ThisWorkbook.FullName
sErrorFile = Left(sErrorFile, Len(sErrorFile) - 4) & " Error.log"
'Write the Error into the Error file
On Error Resume Next
Open sErrorFile For Append As #2
Print #2, CurrentUser(); vbComma; Date; vbComma; Time; vbComma; sModule; vbComma; sProc; vbComma; errNumber; vbComma; errDescr; vbComma; Application.StatusBar
Close #2
'And record it within this database too
' Set rs = CurrentDb.OpenRecordset(st
' With rs
' .AddNew
' ![Date] = Now()
' ![Module] = sModule
' ![Procedure] = sProc
' ![ErrorNumber] = Err.Number
' ![ErrorDescription] = Err.Description
' ![User] = CurrentUser()
' .Update
' End With
' Set rs = Nothing
' iAns = MsgBox("Error: " & sError & Chr(10) & "Continue? ", 276, "Error occurred! Action Required")
' If iAns = 6 Then
' 'GetLogonName
' showError = True
' Else
' DoCmd.Quit
' End If
MsgBox "Please note the following message:" & vbCr & _
"'" & errDescr & "'" & vbCr & vbCr & _
"Current Operation: " & Application.StatusBar & vbCr & _
"This was located in: " & vbCr & _
vbTab & "VB Module: " & vbTab & sModule & vbCr & _
vbTab & "Procedure: " & vbTab & sProc & vbCr & _
"Contact <<your Helpdesk>> for support.", _
vbOKOnly + vbExclamation, _
"" & errSource & ": Error " & errNumber '& "-" & Error(Err.Number)
End Select
End Sub
'*************************
'What: Returns the current user that is logged into either Windows95/NT (and I suspect Windows98 as well)
' NB DO NOT USER ErrOR HANDLING IN THIS ROUTINE AS IT WILL RESET Err WHEN CALLED BY SHOWErrOR()
'Author: Robin 'Nog' Davis
'Created: 22/04/99 10:43:21
'Revised By: -
'When: -
'Parameters: -
'Returns: -
'Called By: -
'Calls: -
'*************************
Public Function CurrentUser() As String
Dim s As String
Dim cnt As Long
Dim dl As Long
Dim CurUser As String
'On Error GoTo CurrentUser_Error
cnt = 199
s = String$(200, 0)
dl = GetUserName(s, cnt)
If dl <> 0 Then
CurrentUser = Left$(s, cnt - 1)
Else
CurrentUser = ""
End If
CurrentUser_Exit:
Exit Function
CurrentUser_Error:
' *****************
' The following section is only used for debugging
'Stop: Resume
' *****************
' ShowError "zvbFunctions", "CurrentUser"
' CurrentUser = ""
' Resume CurrentUser_Exit
End Function
Phew!
Hey guys, that two-liner of mine: it works effectively in a flash [functionality in good time], can be easily modified [requirements meeting], and can be implemented in seconds [low cost and overheads].
But you are right - it won't soft-boil grayco's eggs, or pour a lite beer. Noggy, how's the head?
Dave
Hey guys, that two-liner of mine: it works effectively in a flash [functionality in good time], can be easily modified [requirements meeting], and can be implemented in seconds [low cost and overheads].
But you are right - it won't soft-boil grayco's eggs, or pour a lite beer. Noggy, how's the head?
Dave
Not bad. Not bad at all :-). Thanks for asking, TigerMan. Not sure about the toilet though....
Nice novel Noggy :) I hope it runs quicker than it takes download on my browser
antrat
antrat
Thanks, Antrat. It runs in a flash :-) . I'm thinking about taking up writing, too.....
ASKER
Thank You for your help.
yours was not the shortest solution nor was it the longest.
It was the easiest for me to understand and modify to fit my needs.
Thanks
Again
Glen Ray
yours was not the shortest solution nor was it the longest.
It was the easiest for me to understand and modify to fit my needs.
Thanks
Again
Glen Ray
anytime
antrat
antrat
It seems that my comment I made yesterday didn't get through.
So much for being interested in generic code, grayco :-( . My solution was very easy to understand and extremely well documented. Plus you got extra generic routines considering the quantity of points that you were offering.
Oh well, if you're happy giving away 400 points for some hard-code, who am I to argue :-) ? Got any more questions on the way with that many points :-) ?
So much for being interested in generic code, grayco :-( . My solution was very easy to understand and extremely well documented. Plus you got extra generic routines considering the quantity of points that you were offering.
Oh well, if you're happy giving away 400 points for some hard-code, who am I to argue :-) ? Got any more questions on the way with that many points :-) ?
Noggy, my second example was anything but hard coded, it allowed for any copy range and any destination range and was quite short and to the point.
antrat
antrat
antrat - Yes, your 2nd one was more "generic" but who wants to fill in 2 InputBoxes each time the code is run? And error-trapping when the user enters the wrong type of stuff? Functional but not user-friendly.
When I talk about generic, I'm implying simple code that works under as general conditions as possible. I.e. code that can be used in any application without the need for tweaking and adjusting. However, as you know, it's always tempting to improve on it :-) .
If I took out all my comments, error trapping, easy-reading breaks and generic code extras, my solution would be about the same size as yours (maybe a little larger :-) ).
I know it sounds like sour grapes on my behalf - and you're right to an extent. It just pees me off when q'ers don't seem to have actually tried out solutions we post and look at the merits/disadvantages of each. It seems that grayco just looked at the size of my comment and didn't even bother to read it - let alone try it out. So why bother trying to improve others' skills? Minimalist answers here I come.
When I talk about generic, I'm implying simple code that works under as general conditions as possible. I.e. code that can be used in any application without the need for tweaking and adjusting. However, as you know, it's always tempting to improve on it :-) .
If I took out all my comments, error trapping, easy-reading breaks and generic code extras, my solution would be about the same size as yours (maybe a little larger :-) ).
I know it sounds like sour grapes on my behalf - and you're right to an extent. It just pees me off when q'ers don't seem to have actually tried out solutions we post and look at the merits/disadvantages of each. It seems that grayco just looked at the size of my comment and didn't even bother to read it - let alone try it out. So why bother trying to improve others' skills? Minimalist answers here I come.
OK, so I would tend to feel that Noggy has a point. The justification?
Grayco did not request a 'generic solution' - his needs were very specific, he stated very clearly that he had a semi-fixed range from which he wanted the values only pasted into a permantently fixed range.
My two liner provided exactly that. It requires no interaction. The only thing required to run it would be the correct selection of a date header, and the clicking of a button. The end.
Of course there is the matter of determining the location of the exact destination cells - however I feel that this was described more than adequately, and further help could have been asked for.
A minimalist answer? Ok. but it worked quickly and efficiently.
I must say that I felt the points were a little excessive also.
Ah well, its out with the razor. Thank goodness the weekend is nigh.
Do have fun and Noggy, I envy your ability to tip the odd glass (or three) - I'm one of them two-pot screamers, so have to settle for coffee or Coke.
Dave
Grayco did not request a 'generic solution' - his needs were very specific, he stated very clearly that he had a semi-fixed range from which he wanted the values only pasted into a permantently fixed range.
My two liner provided exactly that. It requires no interaction. The only thing required to run it would be the correct selection of a date header, and the clicking of a button. The end.
Of course there is the matter of determining the location of the exact destination cells - however I feel that this was described more than adequately, and further help could have been asked for.
A minimalist answer? Ok. but it worked quickly and efficiently.
I must say that I felt the points were a little excessive also.
Ah well, its out with the razor. Thank goodness the weekend is nigh.
Do have fun and Noggy, I envy your ability to tip the odd glass (or three) - I'm one of them two-pot screamers, so have to settle for coffee or Coke.
Dave
TigerMan - Your points are good and noted. When such quantities of points are offered, I feel it's my duty to provide an answer (and spend the time) worthy of the points offered. Everyone's submitted answer worked fine but most aren't really worth 400 points.
Some questions, agreed, can only be answered with a 1- or 2-line answer. But they tend to be configuration problems.
I'm not just thinking about the q'er but also the PAQ viewers. After all, if I paid to view a q worth 40 points and only saw a 2-line answer, I would feel a bit miffed. In this case, they have plenty of other alternatives.
Then again, it is all up to the q'er as to which answer to accept.
The razor won't be coming out though as I don't buy many blades. Hence why I can afford to "tip the odd glass". I also don't drink coffee....or Coke (well, unless it has Jack Daniels or Jim Beam in it), so I normally get shedded when I do go out. It's also lucky that you've not got holes in your 2 pots :-).
Some questions, agreed, can only be answered with a 1- or 2-line answer. But they tend to be configuration problems.
I'm not just thinking about the q'er but also the PAQ viewers. After all, if I paid to view a q worth 40 points and only saw a 2-line answer, I would feel a bit miffed. In this case, they have plenty of other alternatives.
Then again, it is all up to the q'er as to which answer to accept.
The razor won't be coming out though as I don't buy many blades. Hence why I can afford to "tip the odd glass". I also don't drink coffee....or Coke (well, unless it has Jack Daniels or Jim Beam in it), so I normally get shedded when I do go out. It's also lucky that you've not got holes in your 2 pots :-).
ASKER
I'm sorry guys that I couldn't use all of your answers. I don't have alot of time to experiment with macros. I just try to use straight forward, easy (for me) to understand solutions.
Noggy,
Yours was truely magnificent, but about 400% overkill for my need. If I ever decide to create a complete software application I would like to have you help me collect all the details. I am amazed that you could pull all that together so quickly. Thank you for all your effort.
Tigerman,
Yours was quick and to the point, but after playing with it for about an hour, I was just beginning to figure out what was copying, how it was selecting and how it was selecting where to paste. I would love to understand your answer better but I just don't have the time to figure it out. (I guess I am just a little slow sometimes)
Antrat,
Your answer was readable to me. I could read it and clearly see what it was doing. My biggest problem was figuring out how to change the commands around a little (which you helped me with)
My only experience programming was with a software written by Cognos to qurery HP databases. It is an ugly old language similar to Basic.
Most of my macro work is done by recording keystrokes. I occasionally modify the code (just a little). I might change an absolute cell reference to an offset, so that the macro can be run from any row or column which ever is the need. or I may turn off the application alerts so I can save a file without having to deal with dialog boxes.
I really didn't mean to offend anyone. Is it wrong to put 400 points on a question? I get the impression you don't see points like that very often.
I don't want you to be angry with me, because I didn't choose your answer.
maybe if I offered fewer points it wouldn't be as important to you. But if it weren't as important maybe you wouldn't give me such great answers.
My needs occur at work. I seem to aquire points just about as fast as I aquire needs. I have another need now and I will post another question for it.
I only have about 300 points so I can't be quite as generous with the next question
Thanks to all of you
Glen Ray
Noggy,
Yours was truely magnificent, but about 400% overkill for my need. If I ever decide to create a complete software application I would like to have you help me collect all the details. I am amazed that you could pull all that together so quickly. Thank you for all your effort.
Tigerman,
Yours was quick and to the point, but after playing with it for about an hour, I was just beginning to figure out what was copying, how it was selecting and how it was selecting where to paste. I would love to understand your answer better but I just don't have the time to figure it out. (I guess I am just a little slow sometimes)
Antrat,
Your answer was readable to me. I could read it and clearly see what it was doing. My biggest problem was figuring out how to change the commands around a little (which you helped me with)
My only experience programming was with a software written by Cognos to qurery HP databases. It is an ugly old language similar to Basic.
Most of my macro work is done by recording keystrokes. I occasionally modify the code (just a little). I might change an absolute cell reference to an offset, so that the macro can be run from any row or column which ever is the need. or I may turn off the application alerts so I can save a file without having to deal with dialog boxes.
I really didn't mean to offend anyone. Is it wrong to put 400 points on a question? I get the impression you don't see points like that very often.
I don't want you to be angry with me, because I didn't choose your answer.
maybe if I offered fewer points it wouldn't be as important to you. But if it weren't as important maybe you wouldn't give me such great answers.
My needs occur at work. I seem to aquire points just about as fast as I aquire needs. I have another need now and I will post another question for it.
I only have about 300 points so I can't be quite as generous with the next question
Thanks to all of you
Glen Ray
Ok, I said to myself I wasn't going to be sucked into this debate but....
Noggy
Grayco first of all offered 360 points for his/her first question, the 1st answer I supplied suited graycos needs and he/she probaly would have awarded me the points. You then convinced Grayco that he/she could have a more "generic" solution for the points being offered. At this stage I thought I could kiss the 360 points goodbye, even though I had answered Grayco's first question to his/her satisfaction.
The reason why I consider my 2nd soultion is generic is one of the reasons why you say it is not i.e "but who wants to fill in 2 InputBoxes each time the code is run" if you re-read the InputBox code you will see it de-faults to any range that grayco sets for both the copy and destination range. If the user needs to type in a different range then it really does become "generic", I mean how else can Excel tell which range is to be copied and which range is the destination?. It is for this reason that the answer supplied can be used in more than one situation.
Tigerman
I very confused by you agreeing with Noggy, as, if grayco had accepted your answer I believe Noggy would have said exactly the same and I doubt you would have voiced your agreement then?
I know at times we feel that our own answer is the best one, but just stop and think a minute what "the best one" really is, I think you will have to agree it is the one that comes closest to suiting the questioner situation.
As I said above I had to live the fact that Noggy had in effect talked Grayco out of awarding me the points initially.
I hope this doesn't come across as me being a bad winner as this is not my intention. I just get offended when it is implied my answer is not worthy of the points being offered. I feel as the hardest part about getting points on EE is not writing the code, but trying write the code to suit the questioner's situation.
antrat
Noggy
Grayco first of all offered 360 points for his/her first question, the 1st answer I supplied suited graycos needs and he/she probaly would have awarded me the points. You then convinced Grayco that he/she could have a more "generic" solution for the points being offered. At this stage I thought I could kiss the 360 points goodbye, even though I had answered Grayco's first question to his/her satisfaction.
The reason why I consider my 2nd soultion is generic is one of the reasons why you say it is not i.e "but who wants to fill in 2 InputBoxes each time the code is run" if you re-read the InputBox code you will see it de-faults to any range that grayco sets for both the copy and destination range. If the user needs to type in a different range then it really does become "generic", I mean how else can Excel tell which range is to be copied and which range is the destination?. It is for this reason that the answer supplied can be used in more than one situation.
Tigerman
I very confused by you agreeing with Noggy, as, if grayco had accepted your answer I believe Noggy would have said exactly the same and I doubt you would have voiced your agreement then?
I know at times we feel that our own answer is the best one, but just stop and think a minute what "the best one" really is, I think you will have to agree it is the one that comes closest to suiting the questioner situation.
As I said above I had to live the fact that Noggy had in effect talked Grayco out of awarding me the points initially.
I hope this doesn't come across as me being a bad winner as this is not my intention. I just get offended when it is implied my answer is not worthy of the points being offered. I feel as the hardest part about getting points on EE is not writing the code, but trying write the code to suit the questioner's situation.
antrat
grayco - Don't worry. I'm not mad at you (or you, antrat) but I do feel such a large amount of points for your request did seem a little excessive. You are quite right in saying that we don't often get questions worth that many points. And, when we do, we all jump at it. However, I know that it's hard to judge how much a question should be worth when you don't know how hard the answer is going to be.
Do bear in mind though that us "experts" are conscious of value-for-money (or points in EE's case). Therefore, a large point question will normally signify to us that the q'er wants a more stylish, complete, generic solution that can be used in other apps.
That's not saying that any of antrat's solutions weren't "complete". Indeed they were. But, if that was the case, neither was Tigerman's who answered first. But I would feel that such a solution for that many points is a little inadequate - well, more of a "laughing all the way to the bank" answer.
Don't get me wrong, it is nice when you get such questions.
Some, as I have said in a previous comment, can only be answered with a 1- or 2-line answer. Even so, we always try to give a little more when we can - especially if it'll guide that q'er onto the right path in their development - or show them what can be achieved in creating solutions much quicker.
You can therefore be less amazed. I pulled the code together for my solution relatively quickly. Some of it was already generic functions that I use in my everyday code. Others were minor adaptions of other functions that I have to make them more specific to your needs. The rest is just aesthetic spacing and comments so that it's easy to read and understand what's going on.
As antrat says, I did twist your arm a little with the generic code angle to the question. I thought that was what you would really want for so many points. But, when you indicated that you would be interested in such a solution, I went to work.
It did seem that my "hard" work was discarded without a comment when you awarded the points to antrat. So I was a little miffed at apparently having wasted my time when you awarded the points to a solution that was proposed prior to your amended spec.. A bit like an amended "3 little pigs" if you will: you ask for a house to be built. One little pig makes one for you out of straw. Another convinces you that that isn't really substantial enough and you agree. The third pig then creates one out of bricks........and then you plump for the straw one anyway.
But now that you have qualified your reasons, I'm happier again :-) . Feel free to have a look at my solution when you have a little more time and want to learn to develop a little more.
There's nothing I could do to stop you anyway :-) .
Antrat - Yeah, you've got the defaults but the user still gets the InputBoxes each time. It doesn't matter though. As you say, it's generic - but it would, in my opinion, be a nag for the user. But that depends on where the user was using it. If they just wanted it as a simple little function that they run when they press a button, fair enough.
But I wouldn't have said the same about TigerMan's answer if grayco had accepted his answer - because grayco would have accepted his as an answer long before I had invested time in creating a more complete solution worthy of that amount of points.
Oh well, I've really blown this one out of the water. I'm not mad at anyone but I did not appreciate having my time wasted. It was valuable pub time after all :-) .
Do bear in mind though that us "experts" are conscious of value-for-money (or points in EE's case). Therefore, a large point question will normally signify to us that the q'er wants a more stylish, complete, generic solution that can be used in other apps.
That's not saying that any of antrat's solutions weren't "complete". Indeed they were. But, if that was the case, neither was Tigerman's who answered first. But I would feel that such a solution for that many points is a little inadequate - well, more of a "laughing all the way to the bank" answer.
Don't get me wrong, it is nice when you get such questions.
Some, as I have said in a previous comment, can only be answered with a 1- or 2-line answer. Even so, we always try to give a little more when we can - especially if it'll guide that q'er onto the right path in their development - or show them what can be achieved in creating solutions much quicker.
You can therefore be less amazed. I pulled the code together for my solution relatively quickly. Some of it was already generic functions that I use in my everyday code. Others were minor adaptions of other functions that I have to make them more specific to your needs. The rest is just aesthetic spacing and comments so that it's easy to read and understand what's going on.
As antrat says, I did twist your arm a little with the generic code angle to the question. I thought that was what you would really want for so many points. But, when you indicated that you would be interested in such a solution, I went to work.
It did seem that my "hard" work was discarded without a comment when you awarded the points to antrat. So I was a little miffed at apparently having wasted my time when you awarded the points to a solution that was proposed prior to your amended spec.. A bit like an amended "3 little pigs" if you will: you ask for a house to be built. One little pig makes one for you out of straw. Another convinces you that that isn't really substantial enough and you agree. The third pig then creates one out of bricks........and then you plump for the straw one anyway.
But now that you have qualified your reasons, I'm happier again :-) . Feel free to have a look at my solution when you have a little more time and want to learn to develop a little more.
There's nothing I could do to stop you anyway :-) .
Antrat - Yeah, you've got the defaults but the user still gets the InputBoxes each time. It doesn't matter though. As you say, it's generic - but it would, in my opinion, be a nag for the user. But that depends on where the user was using it. If they just wanted it as a simple little function that they run when they press a button, fair enough.
But I wouldn't have said the same about TigerMan's answer if grayco had accepted his answer - because grayco would have accepted his as an answer long before I had invested time in creating a more complete solution worthy of that amount of points.
Oh well, I've really blown this one out of the water. I'm not mad at anyone but I did not appreciate having my time wasted. It was valuable pub time after all :-) .
It is a great question for the PAQ database though ;-)
Next time, in another question, maybe I'll steal your code Noggy, to get you really angry ;-)
Next time, in another question, maybe I'll steal your code Noggy, to get you really angry ;-)
No problem, cal. I've noticed that you've stolen my code already ;-) . I've stolen yours occasionally too :-).
Selecting multiple ranges is accomplished with statements like:
Range("D8:D12,D17:D25").Se
The real question is:
How do you tell which column contains 'todays' data? Maybe you are using a date heading in your columns?
Dave