I have a database that I keep track of the top sales by category, and on a weekly basis, if someone moves up the ranks on a year to date statistic, it copies and pastes the persons name, rank and category onto a another sheet.
The way it determines if someone has "moved up" in the ranks, is by copying and pasting last weeks ranks to column A, and column B (through a DB extract) posts the current ranks. If a salesperson has moved up, in column N, it gives the value of "1", and if no movement it equals "0".
So with the following code:
the problem that keeps arising is that it is only copying the last instance of a movement change over. So lets say N1376, has a value of "1" in it, it seems to only be copying and pasting that movement over into the new page. There is clearly over 100 changes (noted by the 1's in column N), so why is this code only copying and pasting the last one and no others?
Thanks for your help in advance.
The way it determines if someone has "moved up" in the ranks, is by copying and pasting last weeks ranks to column A, and column B (through a DB extract) posts the current ranks. If a salesperson has moved up, in column N, it gives the value of "1", and if no movement it equals "0".
So with the following code:
Code:
Dim cell As Range, myRng As Range
Dim Rng1 As Range, Rng2 As Range
Dim PasteRng As Range, RngP1 As Range, RngP2 As Range
Dim LastRow As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("ForumPost").Select
Range("A2:B1400").Select
Selection.ClearContents
Sheets("Changes").Select
'sets the ranges of cells to check
With Sheets("Changes")
Set Rng1 = .Range("N:N")
End With
Set myRng = Rng1
Sheets("ForumPost").Select
'sets range of cells to paste to
With Sheets("ForumPost")
Set RngP1 = .Range("A1:A1376")
End With
For Each cell In myRng
If cell = 1 Then
If Not Intersect(cell, Rng1) Is Nothing Then
'finds first blank cell within first paste range
Set PasteRng = RngP1.Cells(1, 1)
ElseIf Not Intersect(cell, Rng2) Is Nothing Then
'finds first blank cell within second paste range
Set PasteRng = RngP2.Cells.SpecialCells(xlCellTypeBlanks)(1, 1)
End If
'copies A:G of the currently checked row to sheet1
With Sheets("Changes")
.Range(.Cells(cell.Row, "L"), .Cells(cell.Row, "M")).Copy
PasteRng.PasteSpecial (xlPasteValues)
End With
End If
Next cell
Sheets("Career").Select
End Sub
the problem that keeps arising is that it is only copying the last instance of a movement change over. So lets say N1376, has a value of "1" in it, it seems to only be copying and pasting that movement over into the new page. There is clearly over 100 changes (noted by the 1's in column N), so why is this code only copying and pasting the last one and no others?
Thanks for your help in advance.