February 20, 2020
I have made this code and but its run time took maximum time to show result even sheet not respond please make it correct.
Sub MyVBACODE2() Application.ScreenUpdating = False Dim Myrng As Range Dim i As Integer Dim Cell As Variant Dim Source As Range Range("G:G,I:AG,AI:AZ").EntireColumn.Delete Columns("A:A").Insert Shift:=xlToRight LastRow = Range("C" & Rows.Count).End(xlUp).Row For i = 2 To LastRow Cells(i, 5).Value = Trim(Cells(i, 5) & ", " & Cells(i, 3) & " " & Cells(i, 4)) Next i Range("I:I").Cut Range("A:A") Range("B:C").ClearContents Range("H:H").Cut Range("D:D") Range("F:F").Cut Range("J:J") Range("F:F").EntireColumn.Delete Range("G2:G" & LastRow).FormulaR1C1 = "=YEARFRAC(RC[-1],RC[-3])" Range("G1") = "Age" Columns("A:I").EntireColumn.AutoFit Range("H:H").EntireColumn.Delete Range("I1").Select ActiveCell.FormulaR1C1 = "Sex" Range("I2").Select ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""Male"",""M"",""F"")" Range("I2").Select Selection.AutoFill Destination:=Range("I2:I159") Range("I2:I159").Select Columns("I:I").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues Range("H:H").EntireColumn.Delete Range("G:G").Select Selection.Style = "Comma" Range("E:E").Select Set Myrng = Selection For Each Cell In Myrng Cell.Value = WorksheetFunction.Proper(Cell) Next Set Source = Range("E:E") Source.Interior.Color = RGB(255, 255, 255) For Each Cell In Source If Application.WorksheetFunction.CountIf(Source, Cell) > 1 Then Cell.Interior.Color = RGB(255, 0, 0) End If Next Application.ScreenUpdating = True End Sub
1 Guest(s)