VBA CODE REQUIRED

[ShoaibAli]

Dear Experts,
Here is the Attached file and i have create some Code to do this which is incomplete Please made required changes and update the code according to requirements.

Sheet 1 has Data and Sheet2 has result

Sub MyVBACODE()
Dim i As Integer
Range("A:A,G:G,I:AG,AI:AZ").EntireColumn.Delete
Columns("A:A").Insert Shift:=xlToRight
For i = 2 To 10000
Cells(i, 1).Value = Cells(i, 4) & ", " & Cells(i, 2) & " " & Cells(i, 3)
Next i
Range("B:D").EntireColumn.Delete
Columns("A:G").Insert Shift:=xlToRight
Range("L:L").Cut Range("A:A")
Range("K:K").Cut Range("D:D")
Range("H:H").Cut Range("E:E")
Range("J:J").Cut Range("F:F")
Range("i:I").Cut Range("G:G")
worksheet.range("
End Sub

Macros to VBA - OzGrid Free Excel/VBA Help Forum

Dear Experts i'm using below Macros to run my sheet according to requirements but i need to squeeze (Short) this code like VBA. Please Help (Code, 185 lines)

www.ozgrid.com

 

[ShoaibAli]

Fluff

Please help to add Duplicate Font color in given Code.

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"
   With Range("I2:I" & Lastrow)
      .FormulaR1C1 = "=IF(RC[-1]=""Male"",""M"",""F"")"
      .Value = .Value
   End With
   Range("H:H").EntireColumn.Delete
   Range("G:G").Select
   Selection.Style = "Comma"
 
Range("E2:E" & Lastrow).Select
Set Myrng = Selection
For Each Cell In Myrng
Cell.Value = WorksheetFunction.Proper(Cell)
Next


Set Source = Range("E2:E" & Lastrow)
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, 199, 206)
        
        
    ElseIf Application.WorksheetFunction.CountIf(Source, Cell) > 1 Then
      Range("E2:E" & Lastrow).Font.Color = RGB(156, 0, 6)
        
End If
Next
   Application.ScreenUpdating = True
End Sub

 

[Fluff]

It already does

 

[ShoaibAli]

Thanks Alright.