Inserting a column in the end in excel vba

Question

My dataset looks like this

Category dummy1 dummy2

Aan
Abd
Bad
Boy
Abcd

I want to insert a column names "RESULT" in the end, with conditions if category starts with a then RESULT="PASS" if category starts with b then RESULT="FAIL"

ie, my final output should be like this

How can I do this in excel-vba. Please help me.

I am editing the existing spreadsheets.

Dim rngTemp As Range
Set rngTemp = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)

For Each cel In Range(Cells(1, 1), rngTemp)
If cel.Value = "I currently live in" Then
cel.Value = "Current_Domicile"
ElseIf cel.Value = "I am interested in purchasing" Then
cel.Value = "Type_of_Property"
ElseIf cel.Value = "I am interested in purchasing" Then
cel.Value = "Wait_Time"
ElseIf cel.Value = "The reason that I am not buying a house right away is because I am:" Then
cel.Value = "Reason_for_Wait"
End If
Next Cel

I want to add a new column with the conditions above.

Answer 1

you need to use for loop to read the code like this

Sub main()


Dim i, n As Integer
Range("A1").Select

Worksheets("Sheet1").Activate

    n = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

Range("A2").Select

For i = 2 To n

Currentcell = Cells(i, 1).Value

If Left(Currentcell, 1) = "a" Then

Cells(i, 4).Value = "true"


ElseIf Left(Currentcell, 1) = "b" Then

Cells(i, 4).Value = "false"



Else

End If

Next i
End Sub

First take the value of the cell where you want to start and store it in a string, then check whether it is starting with a or b. Then store the value you required in the required cell and continue this till you find the empty cell. Because of that reason i took an integer which counts the range using exceldown.

Iam sorry there was some bug, you can now try like this it will work.

Answer 2

I would go without the loop and take advantage of Excel's inbuilt IF formula:

Sub StartsWithA()
    Cells(1, Columns.Count).End(xlToLeft).Offset(1, 1).Resize(Range("A" & Rows.Count).End(xlUp).Row - 1, 1) = "=IF(UPPER(LEFT(A2,1))=""A"",""pass"",""fail"")"
    Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Formula = "Result"
    activesheet.calculate 'In case your calcs are set to manual
    Cells(1, Columns.Count).End(xlToLeft).Offset(0, 0).Resize(Range("A" & Rows.Count).End(xlUp).Row, 1).Copy
    Cells(1, Columns.Count).End(xlToLeft).Offset(0, 0).Resize(Range("A" & Rows.Count).End(xlUp).Row, 1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

Answer 3

I am not sure the "files" you mentioned were workbooks or worksheets? Anyway,I try with the following code and it worked fine. Hope it help in solving your problem.

Option Explicit
Dim MyWorkbook As Workbook
Dim MyWorksheet As Worksheet

Sub AddLastColumn()
Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
Set MyWorksheet = MyWorkbook.Sheets("WorksheetName")

Dim MyWorksheetLastRow As Long
Dim MyWorksheetLastColumn As Long
Dim MyRowPointer As Long

MyWorksheetLastColumn = MyWorksheet.Cells(1, Columns.Count).End(xlToLeft).Column
MyWorksheet.Cells(1, MyWorksheetLastColumn + 1).Value = "Result"

MyWorksheetLastRow = MyWorksheet.Cells(Rows.Count, "A").End(xlUp).Row

For MyRowPointer = 2 To MyWorksheetLastRow

If InStr(1, MyWorksheet.Cells(MyRowPointer, 1), "A") = 1 Then
    MyWorksheet.Cells(MyRowPointer, MyWorksheetLastColumn + 1).Value = "PASS"
Else
    MyWorksheet.Cells(MyRowPointer, MyWorksheetLastColumn + 1).Value = "FAIL"
End If
Next

End Sub