B
bst
The copy method of the range object does not seem to be working as I
expect. I’m sure it has something to do with how I have written the
destination. Below I’ve included the function I’m using it in. the rest of
the macro and the function itself works fine when I don’t include the
copy. Information that may be helpful:
filteredRange is a range of filtered rows. It is not always contiguous.
The solution must work on non contiguous data, but I don’t think that it
will matter much, since right now I can not get it to cooperate with
contiguous data. filteredRange is Set filteredRange =
ActiveSheet.AutoFilter.Range.Offset(1, 0).SpecialCells
(xlCellTypeVisible). I do have a special function if the range is not
contiguous. The filteredRange will be one or more rows. Rarely will it be
less than 3 rows. If the range is not contiguous when I do the copy, I do
not want the blank unfiltered data copied (again i don't think that would
be an issue, but worth mentioning just incase).
otpWS is the worksheet that conatains the filtered information. It belongs
to a workbook that has 9 other worksheets. filteredRange is the result of
applying the filter to otpWS. I am trying to copy the range to another
sheet in the same workbook.
The commented code under the line, copy range to appropriate worksheet are
my failed attempts.
The uncommented copy code works, but is not what I want. It will overwrite
what I have previously copied. I would like to the specific terminal sheet
to show all its information. otpTerminalSheetRowIndex keeps up with how
many rows have been used so far. It is incremented after the performOTP is
run. (if I have copied 30 rows so far I want to copy current data starting
at row 31).
I’m writing on excel2003, but the final product must work on excel2000
If there is a method with less overhead than copying that will keep my
cell formatting/colors, I would love to hear about it as well.
The code:
Function performOTP(ByRef filteredRange As Range, ByVal
filteredRangeRowCount As Integer) As Integer
Dim earlyLateAllowence As Date
Dim earlyLateCount As Byte
earlyLateCount = 0
Dim xCtr As Byte
Dim timeVariance As Date
Dim actual As Date
Dim sched As Date
otpWS.Activate
With filteredRange.Areas(1)
For xCtr = 1 To filteredRangeRowCount
'this is the allowed time for the stop to be early or late.
'it varies by customer
earlyLateAllowence = whichAllowence(UCase(whichCustomer( _
.Rows(xCtr).Cells(1, otpCBID).Value))) actual =
TimeValue(.Rows(xCtr).Cells(1, otpColActual).Value) sched =
TimeValue(.Rows(xCtr).Cells(1, otpColSched).Value)
'if actual is greater than scheduled, the route was late ....
With .Rows(xCtr).Cells(1, otpColVariance)
If actual = sched Then
.NumberFormat = "hh:mm"
.Value = actual - sched
End If
If actual > sched Then
timeVariance = actual - sched
'now check to see if it was over the allowed time. if so
'color cell red and increase earlyLateCount
'With .Rows(xCtr).Cells(xCtr, otpColVariance)
If timeVariance > earlyLateAllowence Then
.Interior.ColorIndex = 3 'red
earlyLateCount = earlyLateCount + 1
End If
.NumberFormat = "hh:mm"
.Value = timeVariance
'End With
End If
'actual is less than scheduled, then the route was early If
actual < sched Then
timeVariance = sched - actual
'now check to see if it was over the allowed time. if so
'color cell yellow
'With .Rows(xCtr).Cells(xCtr, otpColVariance)
If timeVariance > earlyLateAllowence Then
.Interior.ColorIndex = 6 'yellow
earlyLateCount = earlyLateCount + 1
End If
.NumberFormat = "hh:mm"
.Value = timeVariance
'End With
End If
End With
Next xCtr
'copy the filtered data to appropiate sheet. '''''''does not work,
but is what i
want?''''''''''''''''''''''''''''''''''''''' ' filteredRange.Copy
Destination:=Sheets(terminalNames (whichTerminalIndex)).Range( _ '
Sheets(terminalNames(whichTerminalIndex)).Cells
(otpTerminalSheetRowIndex( _
' whichTerminalIndex), 1))
' Sheets(terminalNames(whichTerminalIndex)).Activate
'.Insert shift:=xlShiftDown
'filteredRange.Select
'Selection.Insert shift:=xlShiftDown
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''works, but not what i
want'''''''''''''''''''''''''''''''''''''''
.Copy Destination:=Sheets(terminalNames(whichTerminalIndex)).Range
("A1")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End With
'return the number of lates/early the route had
Worksheets("Sheet1").Activate
performOTP = earlyLateCount
End Function
TIA
bst
expect. I’m sure it has something to do with how I have written the
destination. Below I’ve included the function I’m using it in. the rest of
the macro and the function itself works fine when I don’t include the
copy. Information that may be helpful:
filteredRange is a range of filtered rows. It is not always contiguous.
The solution must work on non contiguous data, but I don’t think that it
will matter much, since right now I can not get it to cooperate with
contiguous data. filteredRange is Set filteredRange =
ActiveSheet.AutoFilter.Range.Offset(1, 0).SpecialCells
(xlCellTypeVisible). I do have a special function if the range is not
contiguous. The filteredRange will be one or more rows. Rarely will it be
less than 3 rows. If the range is not contiguous when I do the copy, I do
not want the blank unfiltered data copied (again i don't think that would
be an issue, but worth mentioning just incase).
otpWS is the worksheet that conatains the filtered information. It belongs
to a workbook that has 9 other worksheets. filteredRange is the result of
applying the filter to otpWS. I am trying to copy the range to another
sheet in the same workbook.
The commented code under the line, copy range to appropriate worksheet are
my failed attempts.
The uncommented copy code works, but is not what I want. It will overwrite
what I have previously copied. I would like to the specific terminal sheet
to show all its information. otpTerminalSheetRowIndex keeps up with how
many rows have been used so far. It is incremented after the performOTP is
run. (if I have copied 30 rows so far I want to copy current data starting
at row 31).
I’m writing on excel2003, but the final product must work on excel2000
If there is a method with less overhead than copying that will keep my
cell formatting/colors, I would love to hear about it as well.
The code:
Function performOTP(ByRef filteredRange As Range, ByVal
filteredRangeRowCount As Integer) As Integer
Dim earlyLateAllowence As Date
Dim earlyLateCount As Byte
earlyLateCount = 0
Dim xCtr As Byte
Dim timeVariance As Date
Dim actual As Date
Dim sched As Date
otpWS.Activate
With filteredRange.Areas(1)
For xCtr = 1 To filteredRangeRowCount
'this is the allowed time for the stop to be early or late.
'it varies by customer
earlyLateAllowence = whichAllowence(UCase(whichCustomer( _
.Rows(xCtr).Cells(1, otpCBID).Value))) actual =
TimeValue(.Rows(xCtr).Cells(1, otpColActual).Value) sched =
TimeValue(.Rows(xCtr).Cells(1, otpColSched).Value)
'if actual is greater than scheduled, the route was late ....
With .Rows(xCtr).Cells(1, otpColVariance)
If actual = sched Then
.NumberFormat = "hh:mm"
.Value = actual - sched
End If
If actual > sched Then
timeVariance = actual - sched
'now check to see if it was over the allowed time. if so
'color cell red and increase earlyLateCount
'With .Rows(xCtr).Cells(xCtr, otpColVariance)
If timeVariance > earlyLateAllowence Then
.Interior.ColorIndex = 3 'red
earlyLateCount = earlyLateCount + 1
End If
.NumberFormat = "hh:mm"
.Value = timeVariance
'End With
End If
'actual is less than scheduled, then the route was early If
actual < sched Then
timeVariance = sched - actual
'now check to see if it was over the allowed time. if so
'color cell yellow
'With .Rows(xCtr).Cells(xCtr, otpColVariance)
If timeVariance > earlyLateAllowence Then
.Interior.ColorIndex = 6 'yellow
earlyLateCount = earlyLateCount + 1
End If
.NumberFormat = "hh:mm"
.Value = timeVariance
'End With
End If
End With
Next xCtr
'copy the filtered data to appropiate sheet. '''''''does not work,
but is what i
want?''''''''''''''''''''''''''''''''''''''' ' filteredRange.Copy
Destination:=Sheets(terminalNames (whichTerminalIndex)).Range( _ '
Sheets(terminalNames(whichTerminalIndex)).Cells
(otpTerminalSheetRowIndex( _
' whichTerminalIndex), 1))
' Sheets(terminalNames(whichTerminalIndex)).Activate
'.Insert shift:=xlShiftDown
'filteredRange.Select
'Selection.Insert shift:=xlShiftDown
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''works, but not what i
want'''''''''''''''''''''''''''''''''''''''
.Copy Destination:=Sheets(terminalNames(whichTerminalIndex)).Range
("A1")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End With
'return the number of lates/early the route had
Worksheets("Sheet1").Activate
performOTP = earlyLateCount
End Function
TIA
bst