{"id":38,"date":"2025-02-18T19:36:42","date_gmt":"2025-02-18T19:36:42","guid":{"rendered":"https:\/\/database.victorzsantos.com\/?page_id=38"},"modified":"2025-02-25T19:25:13","modified_gmt":"2025-02-25T19:25:13","slug":"vba","status":"publish","type":"page","link":"https:\/\/database.victorzsantos.com\/","title":{"rendered":"VBA"},"content":{"rendered":"\t\t<div data-elementor-type=\"wp-page\" data-elementor-id=\"38\" class=\"elementor elementor-38\" data-elementor-post-type=\"page\">\n\t\t\t\t<div class=\"elementor-element elementor-element-1d26b2b e-flex e-con-boxed e-con e-parent\" data-id=\"1d26b2b\" data-element_type=\"container\">\n\t\t\t\t\t<div class=\"e-con-inner\">\n\t\t\t\t<div class=\"elementor-element elementor-element-78a4cb7 elementor-widget elementor-widget-heading\" data-id=\"78a4cb7\" data-element_type=\"widget\" data-widget_type=\"heading.default\">\n\t\t\t\t<div class=\"elementor-widget-container\">\n\t\t\t\t\t<h2 class=\"elementor-heading-title elementor-size-default\">VBA CODES<\/h2>\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t<div class=\"elementor-element elementor-element-03867cc e-flex e-con-boxed e-con e-parent\" data-id=\"03867cc\" data-element_type=\"container\">\n\t\t\t\t\t<div class=\"e-con-inner\">\n\t\t\t\t<div class=\"elementor-element elementor-element-db2636d e-n-tabs-mobile elementor-widget elementor-widget-n-tabs\" data-id=\"db2636d\" data-element_type=\"widget\" data-settings=\"{&quot;tabs_justify_horizontal&quot;:&quot;center&quot;,&quot;horizontal_scroll&quot;:&quot;disable&quot;}\" data-widget_type=\"nested-tabs.default\">\n\t\t\t\t<div class=\"elementor-widget-container\">\n\t\t\t\t\t\t\t<div class=\"e-n-tabs\" data-widget-number=\"229794669\" aria-label=\"Tabs. Open items with Enter or Space, close with Escape and navigate using the Arrow keys.\">\n\t\t\t<div class=\"e-n-tabs-heading\" role=\"tablist\">\n\t\t\t\t\t<button id=\"e-n-tab-title-2297946691\" class=\"e-n-tab-title\" aria-selected=\"true\" data-tab-index=\"1\" role=\"tab\" tabindex=\"0\" aria-controls=\"e-n-tab-content-2297946691\" style=\"--n-tabs-title-order: 1;\">\n\t\t\t\t\t\t<span class=\"e-n-tab-title-text\">\n\t\t\t\tFrom Hailtrace to Reonomy - Pre Filtered Data #1\t\t\t<\/span>\n\t\t<\/button>\n\t\t\t\t<button id=\"e-n-tab-title-2297946692\" class=\"e-n-tab-title\" aria-selected=\"false\" data-tab-index=\"2\" role=\"tab\" tabindex=\"-1\" aria-controls=\"e-n-tab-content-2297946692\" style=\"--n-tabs-title-order: 2;\">\n\t\t\t\t\t\t<span class=\"e-n-tab-title-text\">\n\t\t\t\tFrom Reonomy - #2 EXPORTUNIQUECONTACTS\t\t\t<\/span>\n\t\t<\/button>\n\t\t\t\t<button id=\"e-n-tab-title-2297946693\" class=\"e-n-tab-title\" aria-selected=\"false\" data-tab-index=\"3\" role=\"tab\" tabindex=\"-1\" aria-controls=\"e-n-tab-content-2297946693\" style=\"--n-tabs-title-order: 3;\">\n\t\t\t\t\t\t<span class=\"e-n-tab-title-text\">\n\t\t\t\tData Organization - #3\t\t\t<\/span>\n\t\t<\/button>\n\t\t\t\t\t<\/div>\n\t\t\t<div class=\"e-n-tabs-content\">\n\t\t\t\t<div id=\"e-n-tab-content-2297946691\" role=\"tabpanel\" aria-labelledby=\"e-n-tab-title-2297946691\" data-tab-index=\"1\" style=\"--n-tabs-title-order: 1;\" class=\"e-active elementor-element elementor-element-5898baf e-flex e-con-boxed e-con e-child\" data-id=\"5898baf\" data-element_type=\"container\">\n\t\t\t\t\t<div class=\"e-con-inner\">\n\t\t\t\t<div class=\"elementor-element elementor-element-f9ff64a elementor-widget elementor-widget-heading\" data-id=\"f9ff64a\" data-element_type=\"widget\" data-widget_type=\"heading.default\">\n\t\t\t\t<div class=\"elementor-widget-container\">\n\t\t\t\t\t<h2 class=\"elementor-heading-title elementor-size-default\">This is the first step. This step begins when you Download the assets from Hailtrace and imports it into Reonomy. Then download that first sheet they give you when import is finished. Here is where we remove the duplicates and the addresses that are not on Reonomy, so it gives us a clean list of properties and addresses.<br><br>The sheet must be renamed to \"ReonomyHailTrace\"<\/h2>\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t<div class=\"elementor-element elementor-element-c3a2487 elementor-widget elementor-widget-text-editor\" data-id=\"c3a2487\" data-element_type=\"widget\" data-widget_type=\"text-editor.default\">\n\t\t\t\t<div class=\"elementor-widget-container\">\n\t\t\t\t\t\t\t\t\t<p>Sub ExportOKStatusAndRemoveDuplicates()<\/p><p>\u00a0 \u00a0 Dim ws As Worksheet, newWs As Worksheet<\/p><p>\u00a0 \u00a0 Dim lastRow As Long, lastCol As Long<\/p><p>\u00a0 \u00a0 Dim i As Long, destRow As Long<\/p><p>\u00a0 \u00a0 Dim filterCols As Variant<\/p><p>\u00a0 \u00a0 Dim statusCol As Long, addressCol As Long<\/p><p>\u00a0 \u00a0 Dim colMapping As Object<\/p><p>\u00a0 \u00a0 Dim cell As Range, srcCol As Long, destCol As Long<\/p><p>\u00a0 \u00a0 Dim key As Variant<\/p><p>\u00a0 \u00a0 Dim statusValue As String<\/p><p>\u00a0 \u00a0 Dim addressDict As Object<\/p><p>\u00a0 \u00a0 &#8216; Set the worksheet to &#8220;ReonomyHailTrace&#8221;<\/p><p>\u00a0 \u00a0 On Error Resume Next<\/p><p>\u00a0 \u00a0 Set ws = ThisWorkbook.Sheets(&#8220;ReonomyHailTrace&#8221;)<\/p><p>\u00a0 \u00a0 On Error GoTo 0<\/p><p>\u00a0 \u00a0 If ws Is Nothing Then<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 MsgBox &#8220;Sheet &#8216;ReonomyHailTrace&#8217; not found!&#8221;, vbExclamation<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 Exit Sub<\/p><p>\u00a0 \u00a0 End If<\/p><p>\u00a0 \u00a0 &#8216; Find last row in the sheet<\/p><p>\u00a0 \u00a0 lastRow = ws.Cells(ws.Rows.Count, &#8220;A&#8221;).End(xlUp).Row<\/p><p>\u00a0 \u00a0 lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column<\/p><p>\u00a0 \u00a0 &#8216; Define the columns to extract<\/p><p>\u00a0 \u00a0 filterCols = Array(&#8220;Address&#8221;, &#8220;City&#8221;, &#8220;State&#8221;, &#8220;Zipcode&#8221;, &#8220;Last Impact Date&#8221;, _<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0&#8220;Location&#8221;, &#8220;Last Meteorologist Hail Impact Date&#8221;, &#8220;Last Meteorologist Hail Impact Size&#8221;)<\/p><p>\u00a0 \u00a0 &#8216; Create dictionaries for column mapping and address tracking<\/p><p>\u00a0 \u00a0 Set colMapping = CreateObject(&#8220;Scripting.Dictionary&#8221;)<\/p><p>\u00a0 \u00a0 Set addressDict = CreateObject(&#8220;Scripting.Dictionary&#8221;) &#8216; To track duplicate addresses<\/p><p>\u00a0 \u00a0 &#8216; Find column indexes for required fields<\/p><p>\u00a0 \u00a0 For Each cell In ws.Rows(1).Cells<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 If Not IsError(Application.Match(Trim(cell.Value), filterCols, 0)) Then<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 colMapping(Trim(cell.Value)) = cell.Column<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 End If<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 If cell.Value = &#8220;status&#8221; Then<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 statusCol = cell.Column<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 End If<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 If cell.Value = &#8220;Address&#8221; Then<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 addressCol = cell.Column<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 End If<\/p><p>\u00a0 \u00a0 Next cell<\/p><p>\u00a0 \u00a0 &#8216; Ensure &#8220;status&#8221; and &#8220;Address&#8221; columns were found<\/p><p>\u00a0 \u00a0 If statusCol = 0 Then<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 MsgBox &#8220;Lowercase &#8216;status&#8217; column not found!&#8221;, vbExclamation<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 Exit Sub<\/p><p>\u00a0 \u00a0 End If<\/p><p>\u00a0 \u00a0 If addressCol = 0 Then<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 MsgBox &#8220;&#8216;Address&#8217; column not found!&#8221;, vbExclamation<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 Exit Sub<\/p><p>\u00a0 \u00a0 End If<\/p><p>\u00a0 \u00a0 &#8216; Create a new sheet for filtered data<\/p><p>\u00a0 \u00a0 On Error Resume Next<\/p><p>\u00a0 \u00a0 Application.DisplayAlerts = False<\/p><p>\u00a0 \u00a0 Sheets(&#8220;Filtered_Data&#8221;).Delete &#8216; Delete existing if it exists<\/p><p>\u00a0 \u00a0 Application.DisplayAlerts = True<\/p><p>\u00a0 \u00a0 On Error GoTo 0<\/p><p>\u00a0 \u00a0 Set newWs = ThisWorkbook.Sheets.Add<\/p><p>\u00a0 \u00a0 newWs.Name = &#8220;Filtered_Data&#8221;<\/p><p>\u00a0 \u00a0 &#8216; Copy headers to new sheet<\/p><p>\u00a0 \u00a0 destCol = 1<\/p><p>\u00a0 \u00a0 For Each key In filterCols<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 If colMapping.exists(key) Then<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 newWs.Cells(1, destCol).Value = key<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 destCol = destCol + 1<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 End If<\/p><p>\u00a0 \u00a0 Next key<\/p><p>\u00a0 \u00a0 &#8216; Copy filtered data where status = &#8220;OK&#8221; and remove duplicate addresses<\/p><p>\u00a0 \u00a0 destRow = 2<\/p><p>\u00a0 \u00a0 For i = 2 To lastRow<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 statusValue = Trim(UCase(ws.Cells(i, statusCol).Value)) &#8216; Normalize status value<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 addressValue = Trim(ws.Cells(i, addressCol).Value) &#8216; Get the address value<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 &#8216; Check if row is &#8220;OK&#8221; and if the address is unique<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 If statusValue = &#8220;OK&#8221; Then<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 If Not addressDict.exists(addressValue) Then<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 addressDict.Add addressValue, True &#8216; Store the address to prevent duplicates<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 destCol = 1<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 For Each key In filterCols<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 If colMapping.exists(key) Then<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 srcCol = colMapping(key)<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 newWs.Cells(destRow, destCol).Value = ws.Cells(i, srcCol).Value<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 destCol = destCol + 1<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 End If<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 Next key<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 destRow = destRow + 1 &#8216; Move to next row in the new sheet<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 \u00a0 End If<\/p><p>\u00a0 \u00a0 \u00a0 \u00a0 End If<\/p><p>\u00a0 \u00a0 Next i<\/p><p>\u00a0 \u00a0 MsgBox &#8220;Filtered data exported successfully with duplicates removed!&#8221;, vbInformation<\/p><p>End Sub<\/p><div>\u00a0<\/div>\t\t\t\t\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t<div id=\"e-n-tab-content-2297946692\" role=\"tabpanel\" aria-labelledby=\"e-n-tab-title-2297946692\" data-tab-index=\"2\" style=\"--n-tabs-title-order: 2;\" class=\" elementor-element elementor-element-1b0be78 e-con-full e-flex e-con e-child\" data-id=\"1b0be78\" data-element_type=\"container\">\n\t\t\t\t<div class=\"elementor-element elementor-element-90254cb elementor-widget elementor-widget-heading\" data-id=\"90254cb\" data-element_type=\"widget\" data-widget_type=\"heading.default\">\n\t\t\t\t<div class=\"elementor-widget-container\">\n\t\t\t\t\t<h2 class=\"elementor-heading-title elementor-size-default\">This step pulls information from the \"contacts\" sheet for the properties that Reonomy gave and put them compiled in different rows, but keep them close for each address. On this step the data is still not organized. This step creates the sheet \"UniqueContacts\"<\/h2>\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t<div class=\"elementor-element elementor-element-4495b54 elementor-widget elementor-widget-text-editor\" data-id=\"4495b54\" data-element_type=\"widget\" data-widget_type=\"text-editor.default\">\n\t\t\t\t<div class=\"elementor-widget-container\">\n\t\t\t\t\t\t\t\t\t<p>Sub ExportUniqueContacts()<\/p><p>\u00a0\u00a0\u00a0 Dim ws As Worksheet, newWs As Worksheet<\/p><p>\u00a0\u00a0\u00a0 Dim lastRow As Long, i As Long, j As Long, rowCount As Long<\/p><p>\u00a0\u00a0\u00a0 Dim addressParts As Variant<\/p><p>\u00a0\u00a0\u00a0 Dim headerCol As Range<\/p><p>\u00a0\u00a0\u00a0 Dim colIndex As Integer<\/p><p>\u00a0\u00a0\u00a0 Dim originalHeaders() As Integer<\/p><p>\u00a0\u00a0\u00a0 Set ws = ThisWorkbook.Sheets(1) &#8216; Assume data is in the first sheet<\/p><p>\u00a0\u00a0\u00a0 &#8216; Create new sheet<\/p><p>\u00a0\u00a0\u00a0 On Error Resume Next<\/p><p>\u00a0\u00a0\u00a0 Set newWs = ThisWorkbook.Sheets(&#8220;UniqueContacts&#8221;)<\/p><p>\u00a0\u00a0\u00a0 If newWs Is Nothing Then<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 Set newWs = ThisWorkbook.Sheets.Add<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 newWs.Name = &#8220;UniqueContacts&#8221;<\/p><p>\u00a0\u00a0\u00a0 Else<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 newWs.Cells.Clear<\/p><p>\u00a0\u00a0\u00a0 End If<\/p><p>\u00a0\u00a0\u00a0 On Error GoTo 0<\/p><p>\u00a0\u00a0\u00a0 &#8216; Define the headers for new sheet and their corresponding original headers<\/p><p>\u00a0\u00a0\u00a0 Dim headers As Variant, sourceHeaders As Variant<\/p><p>\u00a0\u00a0\u00a0 headers = Array(&#8220;Contact Name&#8221;, &#8220;Street Address&#8221;, &#8220;City&#8221;, &#8220;State&#8221;, &#8220;Zip Code&#8221;, _<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 &#8220;Company Name&#8221;, &#8220;Contact Title&#8221;, &#8220;Phone 1&#8221;, &#8220;Phone 2&#8221;, &#8220;Phone 3&#8221;, _<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 &#8220;Phone 4&#8221;, &#8220;Phone 5&#8221;, &#8220;Email 1&#8221;, &#8220;Email 2&#8221;, &#8220;Email 3&#8221;, _<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 &#8220;Email 4&#8221;, &#8220;Email 5&#8221;)<\/p><p>\u00a0\u00a0\u00a0 sourceHeaders = Array(&#8220;contact_name&#8221;, &#8220;subject_address_full&#8221;, &#8220;subject_address_full&#8221;, &#8220;subject_address_full&#8221;, &#8220;subject_address_full&#8221;, _<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 &#8220;contact_company_name&#8221;, &#8220;contact_title&#8221;, &#8220;contact_phone_1&#8221;, &#8220;contact_phone_2&#8221;, &#8220;contact_phone_3&#8221;, _<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 &#8220;contact_phone_4&#8221;, &#8220;contact_phone_5&#8221;, &#8220;contact_email_1&#8221;, &#8220;contact_email_2&#8221;, &#8220;contact_email_3&#8221;, _<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 &#8220;contact_email_4&#8221;, &#8220;contact_email_5&#8221;)<\/p><p>\u00a0\u00a0\u00a0 &#8216; Resize array to hold column positions<\/p><p>\u00a0\u00a0\u00a0 ReDim originalHeaders(LBound(sourceHeaders) To UBound(sourceHeaders))<\/p><p>\u00a0\u00a0\u00a0 &#8216; Write headers to the new sheet and store column positions<\/p><p>\u00a0\u00a0\u00a0 For i = LBound(headers) To UBound(headers)<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 newWs.Cells(1, i + 1).Value = headers(i)<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 Set headerCol = ws.Rows(1).Find(sourceHeaders(i), LookAt:=xlWhole)<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 If Not headerCol Is Nothing Then<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 originalHeaders(i) = headerCol.Column<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 Else<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 originalHeaders(i) = 0 &#8216; Mark as not found<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 End If<\/p><p>\u00a0\u00a0\u00a0 Next i<\/p><p>\u00a0\u00a0\u00a0 lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row<\/p><p>\u00a0\u00a0\u00a0 rowCount = 2<\/p><p>\u00a0\u00a0\u00a0 &#8216; Loop through the data and copy all required columns, even if addresses are repeated<\/p><p>\u00a0\u00a0\u00a0 For i = 2 To lastRow<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 &#8216; Extract address components<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 If originalHeaders(1) &lt;&gt; 0 Then<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 addressParts = Split(ws.Cells(i, originalHeaders(1)).Value, &#8220;,&#8221;)<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 Else<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 addressParts = Split(&#8220;&#8221;, &#8220;,&#8221;) &#8216; Ensure no errors occur<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 End If<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 If originalHeaders(0) &lt;&gt; 0 Then<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 newWs.Cells(rowCount, 1).Value = ws.Cells(i, originalHeaders(0)).Value &#8216; Contact Name<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 End If<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 If UBound(addressParts) &gt;= 0 Then newWs.Cells(rowCount, 2).Value = Trim(addressParts(0)) &#8216; Street Address<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 If UBound(addressParts) &gt;= 1 Then newWs.Cells(rowCount, 3).Value = Trim(addressParts(1)) &#8216; City<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 If UBound(addressParts) &gt;= 2 Then<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 Dim stateZip As Variant<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 stateZip = Split(Trim(addressParts(2)), &#8221; &#8220;)<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 newWs.Cells(rowCount, 4).Value = UCase(Trim(stateZip(0))) &#8216; State (Uppercase)<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 If UBound(stateZip) &gt;= 1 Then newWs.Cells(rowCount, 5).Value = Trim(stateZip(1)) &#8216; Zip Code<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 End If<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 &#8216; Copy other columns<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 For j = 6 To UBound(headers) + 1<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 If originalHeaders(j &#8211; 1) &lt;&gt; 0 Then<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 Dim cellValue As String<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 cellValue = ws.Cells(i, originalHeaders(j &#8211; 1)).Value<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 &#8216; Format phone numbers<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 If j &gt;= 8 And j &lt;= 12 Then &#8216; Phone columns<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 If Len(cellValue) = 11 And Left(cellValue, 1) = &#8220;1&#8221; Then<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 cellValue = Mid(cellValue, 2) &#8216; Remove leading 1<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 End If<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 If Len(cellValue) = 10 And IsNumeric(cellValue) Then<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 cellValue = Format(cellValue, &#8220;(###) ###-####&#8221;)<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 End If<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 End If<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 newWs.Cells(rowCount, j).Value = cellValue<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 End If<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 Next j<\/p><p>\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0\u00a0 rowCount = rowCount + 1<\/p><p>\u00a0\u00a0\u00a0 Next i<\/p><p>\u00a0\u00a0\u00a0 MsgBox &#8220;Contact export complete, including formatting fixes!&#8221;, vbInformation<\/p><p>End Sub<\/p>\t\t\t\t\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t<div id=\"e-n-tab-content-2297946693\" role=\"tabpanel\" aria-labelledby=\"e-n-tab-title-2297946693\" data-tab-index=\"3\" style=\"--n-tabs-title-order: 3;\" class=\" elementor-element elementor-element-382237f e-con-full e-flex e-con e-child\" data-id=\"382237f\" data-element_type=\"container\">\n\t\t\t\t<div class=\"elementor-element elementor-element-1416ad5 elementor-widget elementor-widget-heading\" data-id=\"1416ad5\" data-element_type=\"widget\" data-widget_type=\"heading.default\">\n\t\t\t\t<div class=\"elementor-widget-container\">\n\t\t\t\t\t<h2 class=\"elementor-heading-title elementor-size-default\">This step compiles all of the contact information together on the same row, with multiple columns for different owners, phone numbers and emails. This steps create the sheet \"Refined Data Compiled\"<\/h2>\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t<div class=\"elementor-element elementor-element-d624106 elementor-widget elementor-widget-text-editor\" data-id=\"d624106\" data-element_type=\"widget\" data-widget_type=\"text-editor.default\">\n\t\t\t\t<div class=\"elementor-widget-container\">\n\t\t\t\t\t\t\t\t\t<p>Sub CompileContacts()<\/p><p>Dim ws As Worksheet, newWs As Worksheet<br \/>Dim lastRow As Long, newRow As Long, i As Long, j As Long<br \/>Dim key As String<br \/>Dim dict As Object<\/p><p>&#8216; Ensure the &#8220;UniqueContacts&#8221; sheet is used<br \/>On Error Resume Next<br \/>Set ws = ThisWorkbook.Sheets(&#8220;UniqueContacts&#8221;)<br \/>On Error GoTo 0<\/p><p>If ws Is Nothing Then<br \/>MsgBox &#8220;Worksheet &#8216;UniqueContacts&#8217; not found!&#8221;, vbExclamation<br \/>Exit Sub<br \/>End If<\/p><p>Set dict = CreateObject(&#8220;Scripting.Dictionary&#8221;)<\/p><p>lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row<\/p><p>&#8216; Create new sheet for refined data<br \/>On Error Resume Next<br \/>Application.DisplayAlerts = False<br \/>Sheets(&#8220;Refined Data Compiled&#8221;).Delete<br \/>Application.DisplayAlerts = True<br \/>On Error GoTo 0<\/p><p>Set newWs = ThisWorkbook.Sheets.Add<br \/>newWs.Name = &#8220;Refined Data Compiled&#8221;<\/p><p>&#8216; Set headers for new sheet<br \/>Dim headers As Variant<br \/>headers = Array(&#8220;Street Address&#8221;, &#8220;City&#8221;, &#8220;State&#8221;, &#8220;Zip Code&#8221;, &#8220;Company Name&#8221;)<\/p><p>For i = LBound(headers) To UBound(headers)<br \/>newWs.Cells(1, i + 1).Value = headers(i)<br \/>Next i<\/p><p>newRow = 2<\/p><p>&#8216; Dictionary to track unique addresses<br \/>Dim contactDict As Object<br \/>Set contactDict = CreateObject(&#8220;Scripting.Dictionary&#8221;)<\/p><p>&#8216; Iterate through each row in the original sheet<br \/>For i = 2 To lastRow<br \/>key = ws.Cells(i, 2).Value &amp; &#8220;|&#8221; &amp; ws.Cells(i, 3).Value &amp; &#8220;|&#8221; &amp; ws.Cells(i, 4).Value &amp; &#8220;|&#8221; &amp; ws.Cells(i, 5).Value<\/p><p>If Not contactDict.Exists(key) Then<br \/>contactDict.Add key, newRow<br \/>newWs.Cells(newRow, 1).Value = ws.Cells(i, 2).Value &#8216; Street Address<br \/>newWs.Cells(newRow, 2).Value = ws.Cells(i, 3).Value &#8216; City<br \/>newWs.Cells(newRow, 3).Value = ws.Cells(i, 4).Value &#8216; State<br \/>newWs.Cells(newRow, 4).Value = ws.Cells(i, 5).Value &#8216; Zip Code<br \/>newWs.Cells(newRow, 5).Value = ws.Cells(i, 6).Value &#8216; Company Name<br \/>newRow = newRow + 1<br \/>End If<\/p><p>Dim rowIndex As Integer<br \/>rowIndex = contactDict(key)<\/p><p>&#8216; Find next available contact column<br \/>j = 6<br \/>Do While newWs.Cells(rowIndex, j).Value &lt;&gt; &#8220;&#8221;<br \/>j = j + 8 &#8216; Move to next set of contact columns<br \/>Loop<\/p><p>&#8216; Add headers dynamically<br \/>newWs.Cells(1, j).Value = &#8220;First Name &#8221; &amp; ((j &#8211; 6) \/ 8 + 1)<br \/>newWs.Cells(1, j + 1).Value = &#8220;Last Name &#8221; &amp; ((j &#8211; 6) \/ 8 + 1)<br \/>newWs.Cells(1, j + 2).Value = &#8220;Phone 1 &#8221; &amp; ((j &#8211; 6) \/ 8 + 1)<br \/>newWs.Cells(1, j + 3).Value = &#8220;Phone 2 &#8221; &amp; ((j &#8211; 6) \/ 8 + 1)<br \/>newWs.Cells(1, j + 4).Value = &#8220;Phone 3 &#8221; &amp; ((j &#8211; 6) \/ 8 + 1)<br \/>newWs.Cells(1, j + 5).Value = &#8220;Email 1 &#8221; &amp; ((j &#8211; 6) \/ 8 + 1)<br \/>newWs.Cells(1, j + 6).Value = &#8220;Email 2 &#8221; &amp; ((j &#8211; 6) \/ 8 + 1)<br \/>newWs.Cells(1, j + 7).Value = &#8220;Email 3 &#8221; &amp; ((j &#8211; 6) \/ 8 + 1)<\/p><p>&#8216; Separate first and last names correctly<br \/>Dim nameParts() As String<br \/>nameParts = Split(ws.Cells(i, 1).Value, &#8221; &#8220;, 2)<\/p><p>If UBound(nameParts) = 1 Then<br \/>newWs.Cells(rowIndex, j).Value = nameParts(0) &#8216; First Name<br \/>newWs.Cells(rowIndex, j + 1).Value = nameParts(1) &#8216; Last Name<br \/>Else<br \/>newWs.Cells(rowIndex, j).Value = ws.Cells(i, 1).Value &#8216; If only one name, keep as First Name<br \/>newWs.Cells(rowIndex, j + 1).Value = &#8220;&#8221;<br \/>End If<\/p><p>&#8216; Store phone numbers and emails correctly with filtering<br \/>Dim contactData As Variant, k As Integer, phoneCol As Integer, emailCol As Integer<\/p><p>contactData = Array(ws.Cells(i, 8).Value, ws.Cells(i, 9).Value, ws.Cells(i, 10).Value, ws.Cells(i, 11).Value, ws.Cells(i, 12).Value, ws.Cells(i, 13).Value, ws.Cells(i, 14).Value, ws.Cells(i, 15).Value)<\/p><p>phoneCol = j + 2<br \/>emailCol = j + 5<\/p><p>For k = LBound(contactData) To UBound(contactData)<br \/>If contactData(k) &lt;&gt; &#8220;&#8221; Then<br \/>If InStr(1, contactData(k), &#8220;@&#8221;) &gt; 0 Then<br \/>newWs.Cells(rowIndex, emailCol).Value = contactData(k) &#8216; Ensure only emails go under email columns<br \/>emailCol = emailCol + 1<br \/>ElseIf IsNumeric(Replace(Replace(Replace(contactData(k), &#8220;(&#8220;, &#8220;&#8221;), &#8220;)&#8221;, &#8220;&#8221;), &#8220;-&#8220;, &#8220;&#8221;)) Then<br \/>newWs.Cells(rowIndex, phoneCol).Value = contactData(k) &#8216; Ensure only phone numbers go under phone columns<br \/>phoneCol = phoneCol + 1<br \/>End If<br \/>End If<br \/>Next k<br \/>Next i<\/p><p>MsgBox &#8220;Data compiled successfully!&#8221;, vbInformation<\/p><p>End Sub<\/p>\t\t\t\t\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t\t<\/div>\n\t\t<\/div>\n\t\t\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t<div class=\"elementor-element elementor-element-31a0199 e-flex e-con-boxed e-con e-parent\" data-id=\"31a0199\" data-element_type=\"container\">\n\t\t\t\t\t<div class=\"e-con-inner\">\n\t\t\t\t<div class=\"elementor-element elementor-element-349894a e-n-tabs-mobile elementor-widget elementor-widget-n-tabs\" data-id=\"349894a\" data-element_type=\"widget\" data-settings=\"{&quot;tabs_justify_horizontal&quot;:&quot;center&quot;,&quot;horizontal_scroll&quot;:&quot;disable&quot;}\" data-widget_type=\"nested-tabs.default\">\n\t\t\t\t<div class=\"elementor-widget-container\">\n\t\t\t\t\t\t\t<div class=\"e-n-tabs\" data-widget-number=\"55150922\" aria-label=\"Tabs. Open items with Enter or Space, close with Escape and navigate using the Arrow keys.\">\n\t\t\t<div class=\"e-n-tabs-heading\" role=\"tablist\">\n\t\t\t\t\t<button id=\"e-n-tab-title-551509221\" class=\"e-n-tab-title\" aria-selected=\"true\" data-tab-index=\"1\" role=\"tab\" tabindex=\"0\" aria-controls=\"e-n-tab-content-551509221\" style=\"--n-tabs-title-order: 1;\">\n\t\t\t\t\t\t<span class=\"e-n-tab-title-text\">\n\t\t\t\tProperties + Refined Data Compiled = Merged Data\t\t\t<\/span>\n\t\t<\/button>\n\t\t\t\t<button id=\"e-n-tab-title-551509222\" class=\"e-n-tab-title\" aria-selected=\"false\" data-tab-index=\"2\" role=\"tab\" tabindex=\"-1\" aria-controls=\"e-n-tab-content-551509222\" style=\"--n-tabs-title-order: 2;\">\n\t\t\t\t\t\t<span class=\"e-n-tab-title-text\">\n\t\t\t\tMerged Data + Hailtrace\t\t\t<\/span>\n\t\t<\/button>\n\t\t\t\t\t<\/div>\n\t\t\t<div class=\"e-n-tabs-content\">\n\t\t\t\t<div id=\"e-n-tab-content-551509221\" role=\"tabpanel\" aria-labelledby=\"e-n-tab-title-551509221\" data-tab-index=\"1\" style=\"--n-tabs-title-order: 1;\" class=\"e-active elementor-element elementor-element-c6af6d3 e-flex e-con-boxed e-con e-child\" data-id=\"c6af6d3\" data-element_type=\"container\">\n\t\t\t\t\t<div class=\"e-con-inner\">\n\t\t\t\t<div class=\"elementor-element elementor-element-2371a33 elementor-widget elementor-widget-heading\" data-id=\"2371a33\" data-element_type=\"widget\" data-widget_type=\"heading.default\">\n\t\t\t\t<div class=\"elementor-widget-container\">\n\t\t\t\t\t<h2 class=\"elementor-heading-title elementor-size-default\">This step is to merge the property information such as type, year built, area and etc, to the Refined Data Compiled. If you are questioning why we didn't do it directly from the properties, it's because the contacts are not as specific, therefore this merge is necessary. This step creates the sheet \"Merged Data\"<\/h2>\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t<div class=\"elementor-element elementor-element-3ff3936 elementor-widget elementor-widget-text-editor\" data-id=\"3ff3936\" data-element_type=\"widget\" data-widget_type=\"text-editor.default\">\n\t\t\t\t<div class=\"elementor-widget-container\">\n\t\t\t\t\t\t\t\t\t<p>Sub MergeRefinedAndProperties()<br \/>Dim wsRefined As Worksheet, wsProperties As Worksheet, wsMerged As Worksheet<br \/>Dim lastRowRefined As Long, lastRowProperties As Long, lastColRefined As Long<br \/>Dim refinedDict As Object, colMapping As Object<br \/>Dim propRow As Long, refRow As Long, destRow As Long<br \/>Dim key As String, destCol As Long, companyCol As Long<br \/>Dim addressColRefined As Long, addressColProperties As Long<br \/>Dim requiredCols As Variant<br \/>Dim cell As Range, srcCol As Long<br \/>Dim i As Integer<\/p><p>&#8216; Set worksheets<br \/>On Error Resume Next<br \/>Set wsRefined = ThisWorkbook.Sheets(&#8220;Refined Data Compiled&#8221;)<br \/>Set wsProperties = ThisWorkbook.Sheets(&#8220;properties&#8221;)<br \/>On Error GoTo 0<\/p><p>&#8216; Validate sheets exist<br \/>If wsRefined Is Nothing Or wsProperties Is Nothing Then<br \/>MsgBox &#8220;One or both sheets not found!&#8221;, vbExclamation<br \/>Exit Sub<br \/>End If<\/p><p>&#8216; Find last rows and columns<br \/>lastRowRefined = wsRefined.Cells(Rows.Count, 1).End(xlUp).Row<br \/>lastRowProperties = wsProperties.Cells(Rows.Count, 1).End(xlUp).Row<br \/>lastColRefined = wsRefined.Cells(1, Columns.Count).End(xlToLeft).Column<\/p><p>&#8216; Define property columns to extract<br \/>requiredCols = Array(&#8220;link&#8221;, &#8220;owner_profile_link&#8221;, &#8220;lot_area&#8221;, &#8220;lot_frontage&#8221;, _<br \/>&#8220;lot_depth&#8221;, &#8220;floor_area_ratio&#8221;, &#8220;gross_building_area&#8221;, &#8220;total_units&#8221;, _<br \/>&#8220;total_buildings&#8221;, &#8220;total_residential_units&#8221;, &#8220;total_commercial_units&#8221;, _<br \/>&#8220;property_type&#8221;, &#8220;property_subtype&#8221;, &#8220;year_built&#8221;, &#8220;year_renovated&#8221;, &#8220;stories&#8221;)<\/p><p>&#8216; Create dictionaries for fast lookup<br \/>Set refinedDict = CreateObject(&#8220;Scripting.Dictionary&#8221;)<br \/>Set colMapping = CreateObject(&#8220;Scripting.Dictionary&#8221;)<\/p><p>&#8216; Find column indexes in properties<br \/>For Each cell In wsProperties.Rows(1).Cells<br \/>If Not IsError(Application.Match(cell.Value, requiredCols, 0)) Then<br \/>colMapping(cell.Value) = cell.Column<br \/>End If<br \/>If cell.Value = &#8220;address_line_1&#8221; Then<br \/>addressColProperties = cell.Column<br \/>End If<br \/>Next cell<\/p><p>&#8216; Find column index for &#8220;Street Address&#8221; and &#8220;Company Name&#8221; in Refined Data<br \/>For Each cell In wsRefined.Rows(1).Cells<br \/>If cell.Value = &#8220;Street Address&#8221; Then<br \/>addressColRefined = cell.Column<br \/>End If<br \/>If cell.Value = &#8220;Company Name&#8221; Then<br \/>companyCol = cell.Column<br \/>End If<br \/>Next cell<\/p><p>&#8216; Validate that address and company columns were found<br \/>If addressColProperties = 0 Or addressColRefined = 0 Or companyCol = 0 Then<br \/>MsgBox &#8220;Required columns not found in one of the sheets!&#8221;, vbExclamation<br \/>Exit Sub<br \/>End If<\/p><p>&#8216; Store property data in a dictionary<br \/>For propRow = 2 To lastRowProperties<br \/>key = Trim(UCase(wsProperties.Cells(propRow, addressColProperties).Value))<br \/>If Not refinedDict.exists(key) Then<br \/>refinedDict.Add key, propRow<br \/>End If<br \/>Next propRow<\/p><p>&#8216; Create new sheet for merged data<br \/>On Error Resume Next<br \/>Application.DisplayAlerts = False<br \/>Sheets(&#8220;Merged Data&#8221;).Delete &#8216; Remove if exists<br \/>Application.DisplayAlerts = True<br \/>On Error GoTo 0<br \/>Set wsMerged = ThisWorkbook.Sheets.Add<br \/>wsMerged.Name = &#8220;Merged Data&#8221;<\/p><p>&#8216; Copy ALL data from Refined Data Compiled including formatting and hyperlinks<br \/>wsRefined.UsedRange.Copy<br \/>wsMerged.Cells(1, 1).PasteSpecial Paste:=xlPasteAll<br \/>Application.CutCopyMode = False<\/p><p>&#8216; Find the last column in Merged Data after copying<br \/>lastColRefined = wsMerged.Cells(1, Columns.Count).End(xlToLeft).Column<\/p><p>&#8216; Shift columns to the right to make space for new data<br \/>Dim totalNewCols As Integer<br \/>totalNewCols = UBound(requiredCols) &#8211; LBound(requiredCols) + 1<br \/>wsMerged.Columns(companyCol + 1).Resize(, totalNewCols).Insert Shift:=xlToRight<\/p><p>&#8216; Insert property headers beside \u201cCompany Name\u201d<br \/>destCol = companyCol + 1<br \/>For i = LBound(requiredCols) To UBound(requiredCols)<br \/>If colMapping.exists(requiredCols(i)) Then<br \/>wsMerged.Cells(1, destCol).Value = requiredCols(i)<br \/>destCol = destCol + 1<br \/>End If<br \/>Next i<\/p><p>&#8216; Copy data row by row<br \/>destRow = 2<br \/>For refRow = 2 To lastRowRefined<br \/>key = Trim(UCase(wsRefined.Cells(refRow, addressColRefined).Value))<\/p><p>&#8216; If address is found in properties, merge data<br \/>If refinedDict.exists(key) Then<br \/>propRow = refinedDict(key)<\/p><p>&#8216; Insert property data beside \u201cCompany Name\u201d<br \/>destCol = companyCol + 1<br \/>For i = LBound(requiredCols) To UBound(requiredCols)<br \/>If colMapping.exists(requiredCols(i)) Then<br \/>srcCol = colMapping(requiredCols(i))<br \/>wsMerged.Cells(destRow, destCol).Value = wsProperties.Cells(propRow, srcCol).Value<\/p><p>&#8216; Ensure hyperlinks remain clickable<br \/>If requiredCols(i) = &#8220;link&#8221; Or requiredCols(i) = &#8220;owner_profile_link&#8221; Then<br \/>If wsProperties.Cells(propRow, srcCol).Value &lt;&gt; &#8220;&#8221; Then<br \/>wsMerged.Cells(destRow, destCol).Hyperlinks.Add _<br \/>Anchor:=wsMerged.Cells(destRow, destCol), _<br \/>Address:=wsProperties.Cells(propRow, srcCol).Value, _<br \/>TextToDisplay:=wsProperties.Cells(propRow, srcCol).Value<br \/>End If<br \/>End If<\/p><p>destCol = destCol + 1<br \/>End If<br \/>Next i<br \/>End If<br \/>destRow = destRow + 1<br \/>Next refRow<\/p><p>Application.CutCopyMode = False<br \/>MsgBox &#8220;Merged data successfully created with clickable links and all property data beside Company Name!&#8221;, vbInformation<br \/>End Sub<\/p>\t\t\t\t\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t<div id=\"e-n-tab-content-551509222\" role=\"tabpanel\" aria-labelledby=\"e-n-tab-title-551509222\" data-tab-index=\"2\" style=\"--n-tabs-title-order: 2;\" class=\" elementor-element elementor-element-7d080d6 e-flex e-con-boxed e-con e-child\" data-id=\"7d080d6\" data-element_type=\"container\">\n\t\t\t\t\t<div class=\"e-con-inner\">\n\t\t\t\t<div class=\"elementor-element elementor-element-8b3c7be elementor-widget elementor-widget-heading\" data-id=\"8b3c7be\" data-element_type=\"widget\" data-widget_type=\"heading.default\">\n\t\t\t\t<div class=\"elementor-widget-container\">\n\t\t\t\t\t<h2 class=\"elementor-heading-title elementor-size-default\">For this step you need to upload the Hailtrace data sheet into the main database sheet you are working on, make sure it is called \"Hailtrace\" on the Spreadsheet. This sheet creates the final sheet called \"UpdatedData\".<\/h2>\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t<div class=\"elementor-element elementor-element-9f0d7e1 elementor-widget elementor-widget-text-editor\" data-id=\"9f0d7e1\" data-element_type=\"widget\" data-widget_type=\"text-editor.default\">\n\t\t\t\t<div class=\"elementor-widget-container\">\n\t\t\t\t\t\t\t\t\t<p>Sub MatchAndMergeData()<br \/>Dim wsMerged As Worksheet, wsHailtrace As Worksheet, wsUpdated As Worksheet<br \/>Dim lastRowMerged As Long, lastRowHail As Long<br \/>Dim dict As Object<br \/>Dim cell As Range, addr As String<br \/>Dim matchKey As String, bestMatch As String<br \/>Dim bestScore As Integer, currentScore As Integer, threshold As Integer<br \/><br \/>&#8216; Set worksheets<br \/>Set wsMerged = ThisWorkbook.Sheets(&#8220;Merged Data&#8221;)<br \/>Set wsHailtrace = ThisWorkbook.Sheets(&#8220;Hailtrace&#8221;)<br \/><br \/>&#8216; Create new sheet for updated data<br \/>On Error Resume Next<br \/>Application.DisplayAlerts = False<br \/>Sheets(&#8220;UpdatedData&#8221;).Delete<br \/>Application.DisplayAlerts = True<br \/>On Error GoTo 0<br \/>Set wsUpdated = ThisWorkbook.Sheets.Add<br \/>wsUpdated.Name = &#8220;UpdatedData&#8221;<br \/><br \/>&#8216; Copy MergedData contents to UpdatedData<br \/>wsMerged.Cells.Copy wsUpdated.Cells<br \/><br \/>&#8216; Find last rows<br \/>lastRowMerged = wsUpdated.Cells(wsUpdated.Rows.Count, 1).End(xlUp).Row<br \/>lastRowHail = wsHailtrace.Cells(wsHailtrace.Rows.Count, 1).End(xlUp).Row<br \/><br \/>&#8216; Find column numbers<br \/>Dim colStreetAddr As Integer, colCompany As Integer, colAddress As Integer<br \/>Dim colImpactDate As Integer, colHailDate As Integer, colHailSize As Integer<br \/><br \/>colStreetAddr = Application.Match(&#8220;Street Address&#8221;, wsUpdated.Rows(1), 0)<br \/>colCompany = Application.Match(&#8220;Company Name&#8221;, wsUpdated.Rows(1), 0)<br \/>colAddress = Application.Match(&#8220;Address&#8221;, wsHailtrace.Rows(1), 0)<br \/>colImpactDate = Application.Match(&#8220;Last Impact Date&#8221;, wsHailtrace.Rows(1), 0)<br \/>colHailDate = Application.Match(&#8220;Last Meteorologist Hail Impact Date&#8221;, wsHailtrace.Rows(1), 0)<br \/>colHailSize = Application.Match(&#8220;Last Meteorologist Hail Impact Size&#8221;, wsHailtrace.Rows(1), 0)<br \/><br \/>&#8216; Shift existing columns to the right before inserting new ones<br \/>wsUpdated.Columns(colCompany + 1).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove<br \/>wsUpdated.Columns(colCompany + 2).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove<br \/>wsUpdated.Columns(colCompany + 3).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove<br \/><br \/>&#8216; Add column headers<br \/>wsUpdated.Cells(1, colCompany + 1).Value = &#8220;Last Impact Date&#8221;<br \/>wsUpdated.Cells(1, colCompany + 2).Value = &#8220;Last Meteorologist Hail Impact Date&#8221;<br \/>wsUpdated.Cells(1, colCompany + 3).Value = &#8220;Last Meteorologist Hail Impact Size&#8221;<br \/><br \/>&#8216; Store Hailtrace data in dictionary<br \/>Set dict = CreateObject(&#8220;Scripting.Dictionary&#8221;)<br \/><br \/>For Each cell In wsHailtrace.Range(wsHailtrace.Cells(2, colAddress), wsHailtrace.Cells(lastRowHail, colAddress))<br \/>matchKey = Trim(LCase(cell.Value)) &#8216; Normalize address for better matching<br \/>If Not dict.exists(matchKey) Then<br \/>dict(matchKey) = Array(cell.Offset(0, colImpactDate &#8211; colAddress).Value, _<br \/>cell.Offset(0, colHailDate &#8211; colAddress).Value, _<br \/>cell.Offset(0, colHailSize &#8211; colAddress).Value)<br \/>End If<br \/>Next cell<br \/><br \/>&#8216; Set threshold for fuzzy matching<br \/>threshold = 3 &#8216; Adjust this value if needed<br \/><br \/>&#8216; Match addresses and populate hail data<br \/>For Each cell In wsUpdated.Range(wsUpdated.Cells(2, colStreetAddr), wsUpdated.Cells(lastRowMerged, colStreetAddr))<br \/>addr = Trim(LCase(cell.Value)) &#8216; Normalize address for lookup<br \/><br \/>If dict.exists(addr) Then<br \/>Dim dataArr As Variant<br \/>dataArr = dict(addr)<br \/>Else<br \/>&#8216; Fuzzy matching if exact match not found<br \/>bestScore = 99<br \/>bestMatch = &#8220;&#8221;<br \/>Dim key As Variant<br \/>For Each key In dict.keys<br \/>currentScore = LevenshteinDistance(addr, key)<br \/>If currentScore &lt; bestScore And currentScore &lt;= threshold Then<br \/>bestScore = currentScore<br \/>bestMatch = key<br \/>End If<br \/>Next key<br \/><br \/>If bestMatch &lt;&gt; &#8220;&#8221; Then<br \/>dataArr = dict(bestMatch)<br \/>End If<br \/>End If<br \/><br \/>&#8216; Assign values if match found<br \/>If Not IsEmpty(dataArr) Then<br \/>cell.Offset(0, colCompany &#8211; colStreetAddr + 1).Value = dataArr(0)<br \/>cell.Offset(0, colCompany &#8211; colStreetAddr + 2).Value = dataArr(1)<br \/>cell.Offset(0, colCompany &#8211; colStreetAddr + 3).Value = dataArr(2)<br \/>End If<br \/>Next cell<br \/><br \/>&#8216; Cleanup<br \/>Set dict = Nothing<br \/>MsgBox &#8220;Data merged successfully into &#8216;UpdatedData&#8217; sheet.&#8221;, vbInformation<br \/>End Sub<\/p><p>Function LevenshteinDistance(ByVal s1 As String, ByVal s2 As String) As Integer<br \/>Dim i As Integer, j As Integer<br \/>Dim m As Integer, n As Integer<br \/>Dim d() As Integer<br \/><br \/>m = Len(s1)<br \/>n = Len(s2)<br \/>ReDim d(0 To m, 0 To n)<br \/><br \/>For i = 0 To m<br \/>d(i, 0) = i<br \/>Next i<br \/><br \/>For j = 0 To n<br \/>d(0, j) = j<br \/>Next j<br \/><br \/>For i = 1 To m<br \/>For j = 1 To n<br \/>If Mid(s1, i, 1) = Mid(s2, j, 1) Then<br \/>d(i, j) = d(i &#8211; 1, j &#8211; 1)<br \/>Else<br \/>d(i, j) = Application.WorksheetFunction.Min(d(i &#8211; 1, j) + 1, d(i, j &#8211; 1) + 1, d(i &#8211; 1, j &#8211; 1) + 1)<br \/>End If<br \/>Next j<br \/>Next i<br \/><br \/>LevenshteinDistance = d(m, n)<br \/>End Function<\/p>\t\t\t\t\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t\t<\/div>\n\t\t<\/div>\n\t\t\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t\t\t<\/div>\n\t\t","protected":false},"excerpt":{"rendered":"<p>VBA CODES From Hailtrace to Reonomy &#8211; Pre Filtered Data #1 From Reonomy &#8211; #2 EXPORTUNIQUECONTACTS Data Organization &#8211; #3 This is the first step. This step begins when you Download the assets from Hailtrace and imports it into Reonomy. Then download that first sheet they give you when import is finished. Here is where [&hellip;]<\/p>\n","protected":false},"author":1,"featured_media":0,"parent":0,"menu_order":0,"comment_status":"closed","ping_status":"closed","template":"elementor_header_footer","meta":{"footnotes":""},"class_list":["post-38","page","type-page","status-publish","hentry"],"_links":{"self":[{"href":"https:\/\/database.victorzsantos.com\/index.php?rest_route=\/wp\/v2\/pages\/38","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/database.victorzsantos.com\/index.php?rest_route=\/wp\/v2\/pages"}],"about":[{"href":"https:\/\/database.victorzsantos.com\/index.php?rest_route=\/wp\/v2\/types\/page"}],"author":[{"embeddable":true,"href":"https:\/\/database.victorzsantos.com\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/database.victorzsantos.com\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=38"}],"version-history":[{"count":55,"href":"https:\/\/database.victorzsantos.com\/index.php?rest_route=\/wp\/v2\/pages\/38\/revisions"}],"predecessor-version":[{"id":118,"href":"https:\/\/database.victorzsantos.com\/index.php?rest_route=\/wp\/v2\/pages\/38\/revisions\/118"}],"wp:attachment":[{"href":"https:\/\/database.victorzsantos.com\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=38"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}