Excel VBA Reformat Data - excel

Question

I have some data that will always be 8 columns (A-H) the number of rows could be different every time (Dynamic).
If the string in column A ends with:
"IT", "LN" or "SJ" then the row value in Column G needs to be divided by 100.
If the string ends in "KK" the value in Column G needs to be
divided by 1000.
Otherwise no math operation to the row needs to be performed.
The data also needs to be sorted alphabetically by column C then by column H.
After this is done the header row (1). Can be deleted.
What I have so far "works" but it results in a very long list of 0.0000 values in column G that makes copying out the cleaned data difficult.
Would anyone be able to show me a more efficient solution?
Sub Clean()
Dim wkb As Workbook
Set wkb = ActiveWorkbook
Dim ws As Worksheet
Set ws = ActiveSheet
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add2 Key:=Range("H2:H2500" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ws.Sort
.SetRange Range("A1:H2500")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("I2").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(RIGHT(RC[-8],2) = ""SJ"", RIGHT(RC[-8],2) = ""LN"", RIGHT(RC[-8],2) = ""IT"", RIGHT(RC[-8],2) = ""KK""),IF(RIGHT(RC[-8],2) = ""KK"",RC[-2]/1000,RC[-2]/100),RC[-2])"
Range("I2").Select
Selection.Copy
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
Range("I2500").Select
Range(Selection, Selection.End(xlUp)).Select
Range("I3:I2500").Select
Range("I2500").Activate
ActiveSheet.Paste
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.NumberFormat = "0.0000"
Columns("I").Delete
Dim strDataRange As Range
Dim keyRange As Range
Set strDataRange = Range("A:H")
Set keyRange = Range("C1")
strDataRange.Sort Key1:=keyRange, Header:=xlYes
Rows(1).Delete
End sub
Sample Input Data
Codes
Population
Animal
Type
Size
Housing Qty
Average Cost
Country
SHIB IT
4,504
DOGE
Standard
SMALL
15,019
9.5557
JP
CORG LN
33,052
DOGE
Standard
SMALL
8,816
31,404.9100
FR
SOG SJ
1,417
CAT
Standard
BIG
90
247.2508
ZM
CHOW KK
873
DOGE
Standard
BIG
9,192
177.2797
CN
FLOP AG
991
CAT
Standard
BIG
7
597.0650
BZ
Desired Output Data:

Answer 1

Please, try the next compact and fast code. It will place the range to be processed in an array and drop down the processed result at the end. Now it returns overwriting the existing range. It can be easily adapted to return in another sheet:
Sub processRangeAH()
Dim sh As Worksheet, lastR As Long, rng As Range, arr, i As Long
Set sh = ActiveSheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
Set rng = sh.Range("A1:H" & lastR)
rng.Sort Key1:=sh.Range("H1"), Order1:=xlAscending, Header:=xlYes
arr = rng.Value2
For i = 2 To UBound(arr)
Select Case UCase(Right(arr(i, 1), 2))
Case "IT", "LN", "SJ": arr(i, 7) = arr(i, 7) / 100
Case "KK": arr(i, 7) = arr(i, 7) / 1000
End Select
Next i
rng.Value2 = arr
rng.Sort Key1:=sh.Range("C1"), Order1:=xlAscending, Header:=xlYes
sh.Range("G2:G" & lastR).NumberFormat = "0.0000"
sh.rows(1).Delete
End Sub
I posted this answer some hours before, when I left my office, but by mistake, in another thread...
Just to see how an array can be used, in order to increase the speed for larger range.

Answer 2

Try this. It copies everything to a new sheet so you don't lose the original data. Could be sped up if you have lots of data.
Sub x()
Dim ws As Worksheet, r As Long
Set ws = Worksheets.Add
Sheet1.Range("A1").CurrentRegion.Copy ws.Range("A1") 'assumes data on sheet1 (code name, change to suit)
For r = 2 To ws.Range("A" & Rows.Count).End(xlUp).Row
Select Case Right(ws.Cells(r, 1), 2)
Case "IT", "LN", "SJ": ws.Cells(r, "G").Value = ws.Cells(r, "G").Value / 100
Case "KK": ws.Cells(r, "G").Value = ws.Cells(r, "G").Value / 1000
End Select
Next r
With ws.Sort
.SortFields.Clear
.SortFields.Add2 Key:=ws.Range("C2:C" & ws.Range("A" & Rows.Count).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add2 Key:=Range("H2:H" & ws.Range("A" & Rows.Count).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A1:H" & ws.Range("A" & Rows.Count).End(xlUp).Row)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub