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
Bookmarks