Copy and Paste Problem

[cpounds217]

Hi All,

I am trying to move two columns of data from one sheet to another. Data in the first column to be moved is just text, while data in the second column is a value returned from a formula. I have got that part working. For the most part, the code below works, unless there is a a series of "Hazard Values" at the bottom of 3 or more.


Private Sub RankHazards_Click()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim lastrow1 As Long
Dim lastrow2 As Long
Dim j As Long
Dim i As Long
Dim rng As Range


Set sh1 = wsAnalysis
Set sh2 = wsRanking

lastrow1 = sh1.Range("K" & sh1.Rows.count).End(xlUp).Row
lastrow2 = sh2.Range("C" & sh2.Rows.count).End(xlUp).Row


j = 2


For i = 0 To lastrow1


Set rng = sh1.Range("A2").Offset(i, 0)
If Not (IsNull(rng) Or IsEmpty(rng)) Then


sh1.Range("A" & i + 2).Copy
sh2.Range("B" & j).PasteSpecial xlPasteValues


sh1.Range("L" & i + 2).Copy
sh2.Range("C" & j).PasteSpecial xlPasteValues


j = j + 1
End If
Next i

Application.CutCopyMode = False

Application.ScreenUpdating = False

Range("C1") = "Hazard Value"
Columns("B:C").Sort key1:=Range("C2"), _
order1:=xlDescending, Header:=xlYes


End Sub

I have also attached screengrabs of two different instances. Once where the copy and paste works, and the second where it doesn't.

21578

21579

21580

21581

Interesting point, I just came to find out. If the Ranking Page has all the values in, such as the second image above, and I run the analysis and receive three or more zeroes at the bottom, in a row, it will copy and paste the values. So I am not sure why this is being so difficult.

Any help is greatly appreciated.

[Dave]

It seems to me that this is wrong...

lastrow1 = sh1.Range("K" & sh1.Rows.count).End(xlUp).Row
Which refers to the duration of emergency column and therefore your loop count is wrong. Also, this seems wrong...

If Not (IsNull(rng) Or IsEmpty(rng)) Then
It should be...

If Not rng Is Nothing Then
HTH. Dave
ps. This page seems buggy???

[Paul_Hossler]

@Dave --


ps. This page seems buggy???

I've experienced a few quirks Using IE11 since they've upgraded the forum software

1. Screen flicker in edit boxes
2. Control-c and -v don't work
3. Icons blank on toll bar (sometimes)

Chrome seems to work OK, and for the most part added www.vbaexpress.com (http://www.vbaexpress.com) to IE's Compatibility View also helps somewhat

[Dave]

Hi Paul. You pretty much listed the problems I was encountering except the need to type/re-type real slow. It's somewhat annoying. I don't have any blank icons. Anyways, I stopped using chrome after I found bugs attaching to the history. Thanks for your input. Dave

[Paul_Hossler]

Hi Paul. You pretty much listed the problems I was encountering except the need to type/re-type real slow. It's somewhat annoying. I don't have any blank icons. Anyways, I stopped using chrome after I found bugs attaching to the history. Thanks for your input. Dave

Forgot that one

4. Need to type really slowly

Almost every time leaning on the left arrow key would cause IE to crash

Compatibility View really helped, including having the icons on Quick Reply command bar show almost all the time

[cpounds217]

[QUOTE=Dave;376530]It seems to me that this is wrong...

lastrow1 = sh1.Range("K" & sh1.Rows.count).End(xlUp).Row
Which refers to the duration of emergency column and therefore your loop count is wrong.

Ok, I am confused on how this should be fixed. I tried switching to "xlDown" and it crashed Excel. What would you suggest I try?

Thanks!

[Paul_Hossler]

Try just


lastrow1 = Range("K" & sh1.Rows.count).End(xlUp).Row

[cpounds217]

Try just


lastrow1 = Range("K" & sh1.Rows.count).End(xlUp).Row


Good Suggestion, but the result was the same. I don't think this is as big of a priority as I was making it, my boss doesn't seem concerned about the bug, as he pointed out that anyone doing the Analysis should not expect to see any values of "0". Although, for my sanity, I do want to still solve this as it reflects on the creator if anyone were to happen across this bug.

So please, keep them coming lol.

Thanks!

[Dave]

Change "K" to either "A", "B" or "L".... any column which has data extending to the last row. I should have been more clear in my reply. Dave

[cpounds217]

Change "K" to either "A", "B" or "L".... any column which has data extending to the last row. I should have been more clear in my reply. Dave

So that worked, except now it pastes the values two rows lower than I want it to. So there are the headers, two blank rows, and then the values. I tried a few troubleshooting things, but nothing seemed to affect it much. As you can see its more than just an aesthetic issue. There are embedded formulas within the "Rank" Column which assigns a rank

=If(Cell to right <>"", Cell Above+1, "")


21622

[Dave]

Now that the lastrow is right, the rest of your code needs adjustment. Trial this...

lastRow1 = sh1.Range("A" & sh1.Rows.Count).End(xlUp).Row
j = 2
For i = 2 To lastRow1
Set Rng = sh1.Range("A2").Offset(i - 2, 0)
' If Not (IsNull(Rng) Or IsEmpty(Rng)) Then
If Not Rng Is Nothing Then
sh1.Range("A" & i).Copy
sh2.Range("B" & j).PasteSpecial xlPasteValues
Application.CutCopyMode = False
sh1.Range("L" & i).Copy
sh2.Range("C" & j).PasteSpecial xlPasteValues
Application.CutCopyMode = False
j = j + 1
End If
Next i


Seems like it should work. Untested. Dave

[cpounds217]

Awesome. That worked, particularly once I set lastrow1 to "A" and no other data column. I was even using "L" and it was still acting funky.

[Dave]

Glad U got that sorted out. Thanks for posting your outcome. Dave