+ Reply to Thread
Results 1 to 1 of 1

VBA code to extract text on criteria basis

  1. #1
    Forum Contributor
    Join Date
    03-12-2014
    Location
    India
    MS-Off Ver
    Excel 2013
    Posts
    118

    VBA code to extract text on criteria basis

    Hi,
    Iam Using following code.

    There are few more requirements in addition to the same code. I want code to perform following task at the end of the above code.

    Requirements are

    1) I want to extract the data in column "D" of sheet "Process Data" in same way. Please refer attachment. I have marked the required result in Yellow color in Sheet "Process data". The Data in Column D of sheet "Process Data" to extracted in Column E,F,G and H

    2). Column "S" in Sheet "Process Data". If any cell in Column "S" Contains string starting with "Under Construction" then corresponding cell in Column "Y" will be Blank in originathat text in particular cell should go to Column "Y" in sheet "Process Data". I have marked the example in Blue color.

    Cell "S25" Contains "Under Construction (New Property)". Hence the same text text should come in Cell "Y25"

    Cell "S29" Contains "Under Construction (in six months)". Hence the same text text should come in Cell "Y29"

    3) I want 3 New column Named as "Property Type", "Transaction" and “Proper Location” next to Column "AD" i.e. "AE" as "Property Type" and "AF" as "Transaction" and "AG" as "Proper Location" in Sheet "Process Data".
    Column "AD" contains URL which contains type of Transaction, property type as well as exact location
    (A) Any data Start with” -Commercial- or -Industrial- or -Multistorey- or -Warehouse- or Residential- or any other words (so you give me a option to add additional keyword also)” and ends before -FOR- is a Property type.
    For example in Cell “AD2”, “Multistorey-Apartment” is Property type
    For example in Cell “AD3”, “Commercial-Office-Space” is Property type
    For example in Cell “AD7”, “Industrial-Building” is Property type
    For example in Cell “AD10”, “Office-in-IT-Park-SEZ” is Property type
    For example in Cell “AD14”, “Warehouse-Godown” is Property type
    Hence needed result as mentioned below
    in Cell “AE2” need text as “Multistorey-Apartment”
    in Cell “AE3”, “Commercial-Office-Space”
    in Cell “AE7”, “Industrial-Building”
    in Cell “AE10”, “Office-in-IT-Park-SEZ”
    in Cell “AE14”, “Warehouse-Godown”
    Example marked in Grey colour

    (B) Any data Starts after “-FOR-“ and ends before to next “-“ is a Transaction type.

    For example in Cell “AD2”, “Sale” is Transaction
    For example in Cell “AD3”, “Rent” is Transaction
    For example in Cell “AD4”, “Temp” is Transaction
    For example in Cell “AD5”, “Permanent” is Transaction
    For example in Cell “AD6”, “Sale” is Transaction
    Hence needed result as mentioned below
    in Cell “AF2”, “Sale”
    in Cell “AF3”, “Rent”
    in Cell “AF4”, “Temp”
    in Cell “AF5”, “Permanent”
    in Cell “AF6”, “Sale”
    Example marked in Green colour
    (C) Any data Starts after the transaction and ends before “-in-“ is a Exact Location
    i.e. Data after “-FOR-Sale-“ or “-FOR-Rent-“ or “-FOR-TEMP-“ or “-FOR-Permanent-“ or any other words (so you give me a option to add additional keyword also) and ends before “-in-“ is a exact Location
    For example in Cell “AD2”, “Thakur-Village” is Exact Location
    For example in Cell “AD3”, “Lower-Parel” is Exact Location
    For example in Cell “AD4”, “Nariman-Point” is Exact Location
    For example in Cell “AD5”, “Shayadri-Nagar-Charkop” is Exact Location
    For example in Cell “AD6”, “Andheri-East” is Exact Location
    For example in Cell “AD7”, “Bhiwendi” is Exact Location
    For example in Cell “AD8”, “Kandivali-West” is Exact Location


    Hence needed result as mentioned below
    in Cell “AG2”, “Thakur-Village” is Exact Location
    in Cell “AG3”, “Lower-Parel” is Exact Location
    in Cell “AG4”, “Nariman-Point” is Exact Location
    in Cell “AG5”, “Shayadri-Nagar-Charkop” is Exact Location
    in Cell “AG6”, “Andheri-East” is Exact Location
    in Cell “AG7”, “Bhiwendi” is Exact Location
    in Cell “AG8”, “Kandivali-West” is Exact Location
    Example marked in Red colour


    Option Explicit
    Option Compare Text

    Sub Process_Latest()
    Dim LastCol As Long
    Dim lastRow As Long
    Dim str As Variant
    Dim ws As Worksheet: Set ws = Sheets("Paste data")
    Dim vSplit As Variant
    Dim rCell As Range
    Dim cell As Range
    Dim x, y(), i&, j&, arr, sp
    Application.ScreenUpdating = False


    'Add new sheet "Process Data"
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "Process Data"
    'Add new sheet "Web Harvy EMail ID"
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "Web Harvy EMail ID"

    'Code for Formula = "=SUBSTITUTE
    'Dim LastCol As Long / Dim lastRow As Long (Variable)
    With Sheets("Paste data")
    lastRow = .Range("A1").CurrentRegion.Rows.Count
    LastCol = .Range("A1").CurrentRegion.Columns.Count
    End With
    With Sheets("Process Data")
    .Cells.ClearContents
    .Range(.Cells(1, 1), .Cells(lastRow, LastCol)).Formula = "=SUBSTITUTE(CLEAN(TRIM('Paste Data'!A1)),CHAR(160),"""")"
    End With

    ' Code to paste spacial the entire sheet
    Sheets("Process Data").UsedRange.Value = Sheets("Process Data").UsedRange.Value

    'Give Heading to 1st Column- PropertyCode
    Sheets("Process data").Select
    Range("A1").Value = "Property code"

    'Replace text Property ID in column A
    Columns("A:A").Replace What:="Property ID: ", Replacement:=""

    'Code to insert coloumn next to date
    Columns(3).EntireColumn.Delete

    'Code to change Date format in Column B. (Dim i As Long /Dim str As Variant) are variable)
    For i = 2 To ActiveSheet.UsedRange.Rows.Count
    If Cells(i, 2) <> "" Then
    str = Mid(Cells(i, 2), 10)
    Cells(i, 3) = Mid(str, 5, 2) & "/" & Left(str, 3) & "/" & Right(str, 2)
    End If
    Next

    'Give Heading to 3rd Column- Posted on
    Range("C1").Value = "Posted on"

    'Code to Delete coloumn next to date
    Columns(2).EntireColumn.Delete

    'Code to Insert coloumn next to Price
    Columns(5).Resize(, 2).EntireColumn.Insert

    'Code to clear contetnts next to ptice Coloumn
    Range("E:G").ClearContents
    Columns(5).EntireColumn.Insert
    Columns("D:D").Replace What:=",", Replacement:=""

    'code to convert numbe rto figure variable Dim ws As Worksheet: Set ws = Sheets("Paste data")
    'Dim vSplit As Variant
    'Dim rCell As Range

    For Each rCell In ws.Range("D1:D" & ws.Range("D" & Rows.Count).End(xlUp).Row)
    If Not InStr(1, Trim(rCell), " ") = 0 Then
    vSplit = Split(Trim(rCell), " ")
    Select Case UCase(vSplit(1))
    Case Is = "THOUSAND"
    rCell.Offset(, 1) = CLng(vSplit(0)) * 1000
    Case Is = "LAC"
    rCell.Offset(, 1) = CLng(vSplit(0)) * 100000
    Case Is = "CR"
    rCell.Offset(, 1) = CLng(vSplit(0)) * 10000000
    End Select
    Else
    rCell.Offset(, 1) = rCell
    End If
    Next rCell

    Columns(10).Resize(, 4).EntireColumn.Insert

    'code to Extract Bathroom and bedroom Dim cell As Range
    For Each cell In Range("I:I")
    sp = Split(cell.Value, ",")
    For i = 0 To UBound(sp)
    Select Case True
    Case InStr(2, sp(i), "Bedroom")
    cell.Offset(, 1) = sp(i)
    Case InStr(2, sp(i), "Bathroom")
    cell.Offset(, 2) = sp(i)
    Case Else
    cell.Offset(, 3) = sp(i)
    End Select
    Next
    Next


    'Replace Bedrooms to BHK in column J
    With Columns("J:J")
    .Replace What:=" Bedrooms", Replacement:="BHK"
    .Replace What:=" Bedroom", Replacement:="BHK"
    .Replace What:="Bedrooms", Replacement:="BHK"
    .Replace What:="Bedroom", Replacement:="BHK"
    End With
    'Code to clear contetnts Before an after Bedroom
    Range("E:I,K:M").ClearContents

    'Give Heading to 3rd Column- Posted on
    Range("J1").Value = "Flat Type"

    Columns("N:N").Replace What:="sqft sqyrd sqm acre bigha hectare marla kanal biswa1 biswa2 ground aankadam rood chatak kottah marla cent perch guntha are ", Replacement:=""

    Columns(15).Resize(, 4).EntireColumn.Insert

    'Replace text Property ID in column A
    Columns("N:N").Replace What:="(covered)", Replacement:="(Covered Area) ", LookAt:=xlPart

    'Replace text Property ID in column A
    Columns("N:N").Replace What:="(carpet)", Replacement:="(Carpet Area) ", LookAt:=xlPart

    'Replace text Property ID in column A
    Columns("N:N").Replace What:="(plot)", Replacement:="(Plot Area) ", LookAt:=xlPart

    'code to seperate area, covered plot, carpet Dim x, y(), i&, j&, arr, sp
    x = Range("N1", Cells(Rows.Count, "N").End(xlUp)).Value
    arr = Array("Covered Area", "Carpet Area", "Plot Area")
    ReDim y(1 To UBound(x), 1 To UBound(arr) + 1)

    For i = 1 To UBound(x)
    For j = 0 To UBound(arr)
    If InStr(x(i, 1), arr(j)) Then
    sp = Split(Trim(Split(x(i, 1), arr(j))(0)))
    y(i, j + 1) = sp(UBound(sp) - 3) & " " & sp(UBound(sp) - 2)
    End If
    Next j
    Next i
    Range("O1:Q1").Resize(i - 1).Value = y()
    Range("O1:Q1").Value = arr
    Application.ScreenUpdating = True
    End Sub
    Attached Files Attached Files

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Replies: 3
    Last Post: 12-18-2014, 10:27 AM
  2. Help Needed: Extract text string using very specific criteria
    By Sajo90 in forum Excel Formulas & Functions
    Replies: 6
    Last Post: 04-18-2014, 09:19 PM
  3. [SOLVED] Extract text from a string of text (amend formula to include new criteria)
    By robertguy in forum Excel Formulas & Functions
    Replies: 2
    Last Post: 09-10-2013, 04:53 PM
  4. Replies: 8
    Last Post: 10-12-2012, 12:35 PM
  5. [SOLVED] VBA Code to Extract complete row if the criteria did not match with 4 columns
    By hecgroups in forum Excel Programming / VBA / Macros
    Replies: 11
    Last Post: 09-26-2012, 01:30 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1