Hello all,

I am using the macro below to cut and paste all the same contract numbers
and test results to a new sheet. This works fine except that only
information from column A to column Y will copy and paste. I am missing 3
columns Z, AA, AB. Can anyone tell me what I am doing wrong?

Sub RemoveDuplicates()

Dim allcells As Range, Cell As Range
Dim nodupes As New Collection

On Error Resume Next
For Each Cell In Range("A27:A500")
nodupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0

For Each item In nodupes
UserForm1.ListBox1.AddItem item
Next item

UserForm1.Show

end sub

Thank you in advance for your help....

Eric

The code you posted has nothing to do with cutting and pasting to a new sheet.

"Eric" wrote:

Hello all,

I am using the macro below to cut and paste all the same contract numbers
and test results to a new sheet. This works fine except that only
information from column A to column Y will copy and paste. I am missing 3
columns Z, AA, AB. Can anyone tell me what I am doing wrong?

Sub RemoveDuplicates()

Dim allcells As Range, Cell As Range
Dim nodupes As New Collection

On Error Resume Next
For Each Cell In Range("A27:A500")
nodupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0

For Each item In nodupes
UserForm1.ListBox1.AddItem item
Next item

UserForm1.Show

end sub

Thank you in advance for your help....

Eric

That funny it's been doing it for quit some time now. I just added more
information. I f it doesn't have anything to do with copying and pasting
what does it do, besides sort?

"JLGWhiz" wrote:

The code you posted has nothing to do with cutting and pasting to a new sheet.

"Eric" wrote:

Hello all,

I am using the macro below to cut and paste all the same contract numbers
and test results to a new sheet. This works fine except that only
information from column A to column Y will copy and paste. I am missing 3
columns Z, AA, AB. Can anyone tell me what I am doing wrong?

Sub RemoveDuplicates()

Dim allcells As Range, Cell As Range
Dim nodupes As New Collection

On Error Resume Next
For Each Cell In Range("A27:A500")
nodupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0

For Each item In nodupes
UserForm1.ListBox1.AddItem item
Next item

UserForm1.Show

end sub

Thank you in advance for your help....

Eric

what would you suggest?

"Eric" wrote:

That funny it's been doing it for quit some time now. I just added more
information. I f it doesn't have anything to do with copying and pasting
what does it do, besides sort?

"JLGWhiz" wrote:

The code you posted has nothing to do with cutting and pasting to a new sheet.

"Eric" wrote:

Hello all,

I am using the macro below to cut and paste all the same contract numbers
and test results to a new sheet. This works fine except that only
information from column A to column Y will copy and paste. I am missing 3
columns Z, AA, AB. Can anyone tell me what I am doing wrong?

Sub RemoveDuplicates()

Dim allcells As Range, Cell As Range
Dim nodupes As New Collection

On Error Resume Next
For Each Cell In Range("A27:A500")
nodupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0

For Each item In nodupes
UserForm1.ListBox1.AddItem item
Next item

UserForm1.Show

end sub

Thank you in advance for your help....

Eric

The code that i looked at converted values in a range to strings and added
them to a listbox.

"Eric" wrote:

That funny it's been doing it for quit some time now. I just added more
information. I f it doesn't have anything to do with copying and pasting
what does it do, besides sort?

"JLGWhiz" wrote:

The code you posted has nothing to do with cutting and pasting to a new sheet.

"Eric" wrote:

Hello all,

I am using the macro below to cut and paste all the same contract numbers
and test results to a new sheet. This works fine except that only
information from column A to column Y will copy and paste. I am missing 3
columns Z, AA, AB. Can anyone tell me what I am doing wrong?

Sub RemoveDuplicates()

Dim allcells As Range, Cell As Range
Dim nodupes As New Collection

On Error Resume Next
For Each Cell In Range("A27:A500")
nodupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0

For Each item In nodupes
UserForm1.ListBox1.AddItem item
Next item

UserForm1.Show

end sub

Thank you in advance for your help....

Eric

Here is the complete macro.
Sub RemoveDuplicates()

Sheets("test database").Unprotect "1dickson"
Sheets("test database2").Unprotect "1dickson"
Sheets("moving averages2").Unprotect "1dickson"


Dim allcells As Range, Cell As Range
Dim nodupes As New Collection

On Error Resume Next
For Each Cell In Range("A27:A500")
nodupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0

For Each item In nodupes
UserForm1.ListBox1.AddItem item
Next item

UserForm1.Show

Sheets("test Database").Select
Range("A1").Value = 1

Sheets("test Database2").Select
Range("B2").Value = 1


Sheets("test database").Protect "1dickson"



'***Don's Moving Average*******



Dim intrefrow As Range
Dim dblavgpb As Range
Dim count As Range


Set intrefrow = Sheets("moving averages2").Range("F16")
Set dblavgpb = Sheets("moving averages2").Range("H16")
Set count = Sheets("moving averages2").Range("g16")

Dim dblpb1 As Range
Dim dblpb2 As Range
Dim dblpb3 As Range
Dim dblpb4 As Range


Set dblpb1 = Sheets("Moving Averages2").Range("I16")
Set dblpb2 = Sheets("Moving Averages2").Range("J16")
Set dblpb3 = Sheets("Moving Averages2").Range("K16")
Set dblpb4 = Sheets("Moving Averages2").Range("L16")



Do Until intrefrow.Value - 1 = count

dblpb1 = Sheets("test database2").Cells(intrefrow.Value - 3, 18)
dblpb2 = Sheets("test database2").Cells(intrefrow.Value - 2, 18)
dblpb3 = Sheets("test database2").Cells(intrefrow.Value - 1, 18)
dblpb4 = Sheets("test database2").Cells(intrefrow.Value, 18)




If dblpb4 = "" Then intrefrow.Value = intrefrow + 1 - 1 Else _
intrefrow.Value = intrefrow + 1


Sheets("Moving Averages2").Select
Range("B8:U8").Select
Selection.Copy
Range("B500").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False


Loop

Sheets("Moving Averages2").Select
Range("D15:I220").Select
Selection.NumberFormat = "0"
Range("J15:O220").Select
Selection.NumberFormat = "0.0"
Range("N15:N220").Select
Selection.NumberFormat = "0.0"
Range("R15:R220").Select
Selection.NumberFormat = "0.000"
Range("P15:Q220").Select
Selection.NumberFormat = "0.0"
Application.CutCopyMode = False


Sheets("Test Database2").Select
Range("E33:P235").Select
Selection.NumberFormat = "0"
Range("R27:R235").Select
Selection.NumberFormat = "0.00"
Range("Q33:Q235").Select
Selection.NumberFormat = "0.0"
Range("s33:v235").Select
Selection.NumberFormat = "0.0"
Range("Y33:Z235").Select
Selection.NumberFormat = "0.000"
Range("W33:X235").Select
Selection.NumberFormat = "0.0"
Range("AA33:AB235").Select
Selection.NumberFormat = "0.0"
Range("C33:AB232").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With

Sheet19.Calculate
Sheets("test database2").Protect "1dickson"
Sheets("moving averages2").Protect "1dickson"



End Sub

What it does is copies the test results for the contract number that I
specify over to another sheet "Test data2". It then has a continual moving
average. My only problem is that it is missing the last 3 columns for the
data base.
If you could help it would be much appreciated. by the way, I copied the
macro from VBS

Eric

"JLGWhiz" wrote:

The code that i looked at converted values in a range to strings and added
them to a listbox.

"Eric" wrote:

That funny it's been doing it for quit some time now. I just added more
information. I f it doesn't have anything to do with copying and pasting
what does it do, besides sort?

"JLGWhiz" wrote:

The code you posted has nothing to do with cutting and pasting to a new sheet.

"Eric" wrote:

Hello all,

I am using the macro below to cut and paste all the same contract numbers
and test results to a new sheet. This works fine except that only
information from column A to column Y will copy and paste. I am missing 3
columns Z, AA, AB. Can anyone tell me what I am doing wrong?

Sub RemoveDuplicates()

Dim allcells As Range, Cell As Range
Dim nodupes As New Collection

On Error Resume Next
For Each Cell In Range("A27:A500")
nodupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0

For Each item In nodupes
UserForm1.ListBox1.AddItem item
Next item

UserForm1.Show

end sub

Thank you in advance for your help....

Eric