cpounds217
02-09-2018, 07:56 AM
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.
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.