CODEWITHSUNDEEP
vbaexcel
Mikz
Mikz

Reputation: 591

check for value , compare and copy to another column

I have a sheet with two columns. Column (E) contains ID and names from the data source and column (K) contains ID,which are extracted from comment section.

Column E contains sometime ID, starting with B2C, and sometime names and Id starting with 5. column K contains always ID starting with B2C. the length of the ID B2C is usually 11 to 13 Digit Long. the length of ID starting with 5 is 8 Digit Long.

I would like to have a VBA that checks both the columns, if there is an id starting with 5 or some Name in column E, then it should look into column K, if an ID starting with B2C is present, then it should copy to Column L, else copy the same value(from column E) to column L.

I researched through find and replace. I saw examples where exact Name of find was given and replaced with given Name. I am able to form an algorithm, but struck how to start with code in my case. the code below, has an runn time error

object varaible or with block variable not set .

Sub compare()

Dim i As Long
Dim ws As Worksheet


ws = Sheets("Sheet1")

For i = 1 To Rows.Count

If ws.Cells(i, 11).Value = "" Then

ws.Cells(i, 12).Value = ws.Cells(i, 5).Value

Else

ws.Cells(i, 12).Value = ws.Cells(i, 11).Value

End If

Next i

End Sub

I have an Image below, which Shows the end result.the result should be generated as shown in image

Any lead would be appreciated.

Upvotes: 1

Views: 269

Answers (2)

Wolfie
Wolfie

Reputation: 30047

The issue causing the error message is that you are missing a Set statement for your worksheet object. You must use Set when assigning an object to a variable, that is anything with its own methods. A simple data type without methods (String, Integer, Long, Boolean, ...) doesn't need the Set statement, and can just be directly assigned like i = 0.

Your code should be updated to:

Dim i As Long
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
' RED FLAG! Rows.Count is going to cause you to loop through the entire column,
' see the below example for how to use the UsedRange property.
For i = 1 To Rows.Count 
    If ws.Cells(i, 11).Value = "" Then
        ws.Cells(i, 12).Value = ws.Cells(i, 5).Value
    Else
        ws.Cells(i, 12).Value = ws.Cells(i, 11).Value
    End If
Next I

An alternative which avoids even using a worksheet variable would be to use a With block:

Dim r As Long
With ThisWorkbook.Sheets("Sheet1")
    For r = 2 To .UsedRange.Rows.Count
        .Range("L" & r).Value = .Range("E" & r).Value
        If .Range("K" & r).Value = "" Then .Range("L" & r).Value = .Range("K" & r).Value
    Next r
End With

Edit:
There are various ways to find the last used row, each with their drawbacks. A drawback of both UsedRange and xlCellTypeLastCell is they are only reset when you save/close/re-open the workbook. A better solution can be found in this answer. 

Sub compare()
    Dim r As Long, lastrow As Long, ws As WorkSheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastrow = LastRowNum(ws)
    With ws
        For r = 2 To lastrow
            .Range("L" & r).Value = .Range("E" & r).Value
            If .Range("K" & r).Value = "" Then .Range("L" & r).Value = .Range("K" & r).Value
        Next r
    End With   
End Sub

' Function from linked question
Public Function LastRowNum(Sheet As Worksheet) As Long
    LastRowNum = 1
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        LastRowNum = Sheet.Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    End If
End Function

Upvotes: 1

Vityata
Vityata

Reputation: 43575

This is my solution:

Option Explicit

Sub Compare()

    Dim i               As Long
    Dim lngLastRow      As Long
    Dim ws              As Worksheet

    lngLastRow = Range("A1").SpecialCells(xlCellTypeLastCell).Row

    Set ws = Worksheets(1)

    With ws
        .Columns(12).Clear
        .Cells(1, 12) = "Extract from Comment"
        For i = 1 To lngLastRow
            If .Cells(i, 11).Value = "" Then
                .Cells(i, 12).Value = ws.Cells(i, 5).Value
            Else
                .Cells(i, 12).Value = ws.Cells(i, 11).Value
            End If
        Next i
    End With

End Sub

It clears column(12) and writes Extract from comment in the first cell of the row, to make sure that everything is clean. lngLastRow is the last row of the sheet.

Upvotes: 1

Related Questions