Solved

Selecting multiple ranges in a macro

Posted on 2000-04-21
40
596 Views
Last Modified: 2012-05-04
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?
0
Comment
Question by:grayco
  • 12
  • 11
  • 8
  • +2
40 Comments
 
LVL 5

Expert Comment

by:TigerMan
ID: 2738761
grayco,

Selecting multiple ranges is accomplished with statements like:

Range("D8:D12,D17:D25").Select

The real question is:
How do you tell which column contains 'todays' data?  Maybe you are using a date heading in your columns?

Dave
0
 

Author Comment

by:grayco
ID: 2738843
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").Select

won't do that.
GR
0
 
LVL 9

Expert Comment

by:antrat
ID: 2739191
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:IV1")

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

0
 
LVL 5

Expert Comment

by:TigerMan
ID: 2739293
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.Row + C + 6, ActiveCell.Column).Value _
                                 = ActiveCell.Offset(6 + C, 0).Value
Next C

For C = 1 To 9
   Worksheets("Sheet2").Cells(ActiveCell.Row + C + 15, ActiveCell.Column).Value _
                                 = ActiveCell.Offset(15 + C, 0).Value
Next C
End Sub

Dave
0
 
LVL 5

Expert Comment

by:TigerMan
ID: 2739296
That should be:

Sub CopyToday()

For C = 1 To 5
   Worksheets("Sheet2").Cells(ActiveCell.Row + C + 6, ActiveCell.Column).Value _
                                 = ActiveCell.Offset(6 + C, 0).Value
Next C

For C = 1 To 9
   Worksheets("Sheet2").Cells(ActiveCell.Row + C + 15, ActiveCell.Column).Value _
                                 = ActiveCell.Offset(15 + C, 0).Value
Next C
End Sub


Dave
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2739713
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).EntireColumn

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(.Cells(8,1), .Cells(12,1)).EntireRow,.Range(.Cells(17,1), .Cells(25,1).EntireRow)

    'Now intersect this range with the column that you want - I'm using column 2 as an example
    Set MyRange = Application.Intersect(MyRange, rngCol.EntireColumn)
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.
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2739715
Oops, where I've written:

MyRange_Exit:
    Set MyRange = Nothing
    Exit Function

It should read:

MyRange_Exit:
    Exit Function
0
 

Author Comment

by:grayco
ID: 2740434
Adjusted points from 300 to 360
0
 

Author Comment

by:grayco
ID: 2740435
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
0
 

Author Comment

by:grayco
ID: 2740529
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
0
 
LVL 5

Expert Comment

by:TigerMan
ID: 2740826
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.Row + C + 6, ActiveCell.Column).Value _
                                 = 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
0
 
LVL 9

Accepted Solution

by:
antrat earned 400 total points
ID: 2741035
Hi grayco

You could use the "PasteSpecial" operation to paste values only but it may be more efficient to use the method below.

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
 DestR.Range("A2").Value = .Offset(3, 0).Value
 DestR.Range("A2").Value = .Offset(5, 0).Value
 DestR.Range("A3").Value = .Offset(10, 0).Value
End With
End Sub


antrat
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2741408
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 :-) .
0
 
LVL 17

Expert Comment

by:calacuccia
ID: 2741781
Hi, I'm waiting too :-)
0
 

Author Comment

by:grayco
ID: 2741972
Adjusted points from 360 to 400
0
 

Author Comment

by:grayco
ID: 2741973
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
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2742074
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....
0
 
LVL 5

Expert Comment

by:TigerMan
ID: 2742520
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
0
 
LVL 5

Expert Comment

by:TigerMan
ID: 2742744
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
0
 
LVL 5

Expert Comment

by:TigerMan
ID: 2742760
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

0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 5

Expert Comment

by:TigerMan
ID: 2742769
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
0
 
LVL 5

Expert Comment

by:TigerMan
ID: 2742972
I can say that again!
0
 
LVL 9

Expert Comment

by:antrat
ID: 2743175
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, WorksheetFunction.Find _
(",", rws), 8, "")
Rng2 = WorksheetFunction.Replace(rws, 1, Len(Rng1) + 1, "")


'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, WorksheetFunction.Find _
(",", Rws2), 8, "")
DestR2 = WorksheetFunction.Replace(Rws2, WorksheetFunction.Find _
(",", Rws2), Len(DestR1) + 1, "")

Union(Range(Rng1).Columns(ColN), Range(Rng2).Columns(ColN)).Copy
DestSht.Cells(DestR1, DestR2.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End If
End If
End Sub



Have fun
antrat
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2743451
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([TankLevelsInGallons], [Average7Day]).EntireRow
    'And now refine the selection so that we only have the corresponding cells for today.
    Set rngToCopy = Application.Intersect(rngToCopy, cellTankLevelDate.EntireColumn)
   
    '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], True, True, False)) Then
        '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].Parent.Cells(1, [EstimatedUsageStartCell].Column)
        .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(ContainingDate)
   
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.PasteSpecial xlPasteValues
        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.PasteSpecial xlPasteValues
            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(rngArea.Rows.Count, 0)
            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.Name & "]."
    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(stblVBError)
'        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
0
 
LVL 5

Expert Comment

by:TigerMan
ID: 2744873
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  
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2746663
Not bad. Not bad at all :-). Thanks for asking, TigerMan. Not sure about the toilet though....
0
 
LVL 9

Expert Comment

by:antrat
ID: 2746870
Nice novel Noggy :) I hope it runs quicker than it takes download on my browser


antrat
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2747050
Thanks, Antrat. It runs in a flash :-) . I'm thinking about taking up writing, too.....
0
 

Author Comment

by:grayco
ID: 2773618
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
0
 
LVL 9

Expert Comment

by:antrat
ID: 2776244
anytime

antrat
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2776686
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 :-) ?
0
 
LVL 9

Expert Comment

by:antrat
ID: 2776726
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
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2776782
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.

0
 
LVL 5

Expert Comment

by:TigerMan
ID: 2776851
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
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2778443
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 :-).
0
 

Author Comment

by:grayco
ID: 2779576
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
0
 
LVL 9

Expert Comment

by:antrat
ID: 2779640
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
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2780608
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 :-) .
0
 
LVL 17

Expert Comment

by:calacuccia
ID: 2780681
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 ;-)
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2785946
No problem, cal. I've noticed that you've stolen my code already ;-) . I've stolen yours occasionally too :-).
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Have you ever had the experience that you had to follow 10 steps over and over again every time when you need to nicely forward an important email to your manager? Fear no more! With the help of the Quick Steps feature in Outlook 2010, your old chor…
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
This video shows where to find templates, what they are used for, and how to create and save a custom template using Microsoft Word.
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now