• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA Code to Complete Actioin

ShoaibAli

New Member
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


Code:
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")





    Range("H2").Select

    ActiveCell.FormulaR1C1 = "=YEARFRAC(RC[-2],RC[-4])"

    Range("H2").Select

    Selection.AutoFill Destination:=Range("H2:H10000")

    Range("H2:H10000").Select

    ActiveWindow.SmallScroll Down:=-9



Range("H1") = "AGE"



    Columns("H:H").Select

    Selection.Insert Shift:=xlToRight

    Range("H2").Select

    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""Male"",""M"",""F"")"

    Range("H2").Select

    Selection.AutoFill Destination:=Range("H2:H10000")

    Range("H2:H10000").Select

  

 

   Range("E1") = "Sex"

   Range("G:G").Delete

End Sub
 

Attachments

  • Book2.xlsx
    54.7 KB · Views: 2
Last edited:
You will find that this site has the same rules about cross posting, as the other sites where you have asked this question.

 
vletm

I did but your code is giving error would you please Edit this Code this is working fine but not calculating the age and not converting the Male female paortion as M and F

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"
   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
 
Last edited:
Yeah agreed you edited but i need also some changes i made it further by Macros helping and it is too much slow while running. If you could help me out further i would really appreciate.
 
Back
Top