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

I did it by Macro please convert it in VBA.

Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveCell.FormulaR1C1 = "=YEARFRAC(RC[-1],RC[-3])"
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G159")
    Range("G2:G159").Select
    Selection.Style = "Comma"
    Columns("G:G").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

 

[ShoaibAli]

Sub MyVBACODE2()


Application.ScreenUpdating = False
Dim i As Integer
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"
Application.ScreenUpdating = True
End Sub

 

[Fluff]

Link is in my first comment.

That is a link to Ozgrid, as we have discussed before, you MUST supply links to ALL sites where you have asked this question.
Please do so.

 

[ShoaibAli]

Sorry i forgot. But after updating same question did not get solution.

VBA Code to Complete Actioin

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...

chandoo.org

 

[ShoaibAli]

Code need to modify. Please help.

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(221, 235, 247)
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

 

[Fluff]

In what way does it need to be modified?

 

[ShoaibAli]

Fluff

I have added the remaining function but it is taking too much time to show the result.

 

[Fluff]

Try it like

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(221, 235, 247)
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

 

[ShoaibAli]

Fluff

ThankYou so much Fluff you helping me alot you are true Gem.

 

[Fluff]

You're welcome & thanks for the feedback