VBA Excel IF condition for splitting address columns

Question

I would like to split my addresses into separate cells. My address is combined by commas and basically, the number of separate cells is comma-dependant.

I found and implemented a very good solution, which is under the following thread here:

Split address field in Excel

It works, but the primary condition is keeping the string with the same number of commas.

If for example, the address looks like this:

1 - 40 Williams Court, 24-26 Poole Road, Bournemouth, BH4 9DT

then it's fine (regarding my whole macro),

but when the address is shorter (including 2 instead of 3 commas in the whole string)

12 Boyd Close, Coventry, CV2 2NF

then in turn I am getting a mess like below:

So I need the if statement, which will allow me to distinguish the shorter and longer address strings.

I've prepared one column, where I defined the number of commas.

Regarding this I tried to implement the following code:

  Dim Wksht As Worksheet

  Dim MyArray() As String, myPath As String
  Dim lRow As Long, i As Long, j As Long, c As Long


  Set Wksht = ThisWorkbook.Sheets("Final")

  Set Wksht = ThisWorkbook.Sheets("Final")


  Sheets("Address").Application.Union(Columns("J"), Columns("P"), Columns("O")).Copy
  Wksht.Columns("A:B").PasteSpecial xlPasteValues

  Wksht.Columns("A").ColumnWidth = 60
  Wksht.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

  Wksht.Columns("A:D").Insert Shift:=xlToRight, _
  CopyOrigin:=xlFormatFromLeftOrAbove


  Dim LastRow As Long, i As Long
  With Wksht
    LastRow = .Cells(.Rows.Count, "F").End(xlUp).row
  End With
  For i = 1 To LastRow
  If ActiveSheet.Range("U" & i) = 3 Then
   With Wksht
    lRow = .Range("E" & .Rows.Count).End(xlUp).row
    For i = 1 To lRow
        If InStr(1, .Range("E" & i).Value, ",", vbTextCompare) Then
            MyArray = Split(.Range("E" & i).Value, ",")
            c = 1
            For j = 0 To UBound(MyArray)
                .Cells(i, c).Value = MyArray(j)
                c = c + 1
            Next j
        End If
    Next i
   End With
   End If
  Next i

There is no error at all. The debugger just shows:

       If InStr(1, .Range("E" & i).Value, ",", vbTextCompare) Then

but I don't understand, why am I receiving empty columns. Why this code is not executed at all?

I want these addresses split regarding the number of commas defined in the separate column.

UPDATED:

This approach also doesn't work

 For i = 1 To lLastRow
 If Wksht.Range("F" & i).Value = 2 Then
 Wksht.Range("C" & i).Value = Wksht.Range("D" & i).Value
 End If
 Next i

Admin · Answer

As @Alex K. pointed out, this is a job that Text to Columns was designed for. Please try the code below – it is based on the data layout off your second image (original data in column E) and on the sheet called Final.

Option Explicit
Sub Macro1()
Dim LastRow As Long, ws As Worksheet
Set ws = ThisWorkbook.Sheets("Final")
LastRow = ws.Cells(Rows.Count, 5).End(xlUp).Row

Application.DisplayAlerts = False   '<~~ to stop the warning if data already exists at the destination

ws.Range("E1:E" & LastRow).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1))

Application.DisplayAlerts = True

End Sub

EDIT

If your aim is purely to separate the postcode from the rest of the address, you could achieve this based on the location of the last comma in the string (as opposed to the number of commas) using the in-built InStrRev() function.

The following code assumes the complete address is in column E and puts the address (minus the postcode) in column A - and puts the postcode (minus the rest of the address) in column B. All on the sheet called Final.

Option Explicit
Sub SeparatePostCode()
Dim LastRow As Long, ws As Worksheet, c As Range, adr As String
Set ws = ThisWorkbook.Sheets("Final")
LastRow = ws.Cells(Rows.Count, 5).End(xlUp).Row

'Get the address minus the postcode
For Each c In ws.Range("A1:A" & LastRow)
    adr = c.Offset(0, 4).Value
    c.Value = Mid(adr, 1, Len(adr) - (Len(adr) - InStrRev(adr, ",") + 1))
Next c

'Get the postcode minus the address
For Each c In ws.Range("B1:B" & LastRow)
    adr = c.Offset(0, 3).Value
    c.Value = Right(adr, (Len(adr) - InStrRev(adr, ",") - 1))
Next c

End Sub

VBA Excel IF condition for splitting address columns

1 Answers