Clone neighbour cell if blank; remove hyphens if leading cell char is P

[Imrhien]

G'day guys!

I'm writing a big macro that fixes address data. I need two more functions.

1. For column K, search for blanks. For every blank cell, replace value with the value from the neighbouring cell in column J. Must exit gracefully if there are no values to be changed!

2. For column H, search for cells that have values that start with a 'P'. Remove all '-' characters in those cells. (This is to fix any PO Box numbers that contain hyphens, as our system does not use them).

Any and all help is hugely appreciated.

 

[repairman615]

Hello,

Test this for the first part.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> FillBlankFromRight()<br><br><SPAN style="color:#00007F">Dim</SPAN> rngBlank <SPAN style="color:#00007F">As</SPAN> Range<br><SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> Range<br><br><SPAN style="color:#00007F">Set</SPAN> rngBlank = Range("K1:K" & Range("J" & Rows.Count).End(xlUp).Row)<br><br><SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> rngBlank.SpecialCells(xlCellTypeBlanks)<br>    c.Value = c.Offset(0, -1).Value<br><SPAN style="color:#00007F">Next</SPAN> c<br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

-Jeff

 

[cstimart]

G'day guys!

I'm writing a big macro that fixes address data. I need two more functions.

1. For column K, search for blanks. For every blank cell, replace value with the value from the neighbouring cell in column J. Must exit gracefully if there are no values to be changed!

2. For column H, search for cells that have values that start with a 'P'. Remove all '-' characters in those cells. (This is to fix any PO Box numbers that contain hyphens, as our system does not use them).

Any and all help is hugely appreciated.

Try this...

Sub Address_Fixes()
Dim LR As Long
Dim i As Long
Dim hLen As Integer
Dim hypLoc As Integer

LR = Range("J" & Rows.Count).End(xlUp).Row

For i = 1 To LR
    If Range("K" & i) = "" Then
        Range("K" & i) = Range("J" & i)
    End If
    
    hypLoc = InStr(Range("H" & i), "-")
    If hypLoc > 0 Then
        hLen = Len(Range("H" & i))
        Range("H" & i) = Left(Range("H" & i), hypLoc - 1) & Right(Range("H" & i), hLen - hypLoc)
    End If
Next i
End Sub

 

[Trebor76]

Hi Imrhien,

Here's my attempt:

Option Explicit
Sub Macro1()

    'http://www.mrexcel.com/forum/newreply.php?do=newreply&noquote=1&p=2856182

    Dim lngLastRow As Long
    Dim rngCell As Range
    
    If WorksheetFunction.CountA(Cells) > 0 Then
        'Find the last row from columns H to K (inclusive)
        lngLastRow = Range("H:K").Find("*", SearchOrder:=xlByRows, searchDirection:=xlPrevious).Row
    Else
        MsgBox "There is no data on """ & ActiveSheet.Name & """ to work with!!", vbInformation, "Data Editor"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    For Each rngCell In Range("H2:H" & lngLastRow)
    
        'If the first character of Col H is 'P', then...
        If StrConv(Left(rngCell.Value, 1), vbUpperCase) = "P" Then
            '...replace any hyphens in the text with a space (change to suit)
            If InStr(rngCell.Value, "-") > 0 Then
                Do Until rngCell.Find("-") Is Nothing
                    rngCell.Replace What:="-", Replacement:=" "
                Loop
            End If
        End If
        'If there's no entry in Col K, then...
        If Len(rngCell.Offset(0, 3).Value) = 0 Then
            '...put the value in Col J in it.
            rngCell.Offset(0, 3).Value = rngCell.Offset(0, 2).Value
        End If
        
    Next rngCell
    
    Application.ScreenUpdating = True
                  
End Sub

HTH

Robert

 

[Imrhien]

Thank you so much folks!

I ended up using a combination of two solutions submitted; CstiMart's neighbouring cell cloner and Trebor76's hyphen remover. Cstimart's hyphen remover was removing all hyphens, not just from the PO Box values!

Again, you guys are brilliant. + Karma for everyone who responded.

    ' 13.7 Copy the TOWN value if the SUBURB is blank
    Dim LR2 As Long
    Dim i2 As Long
    
    LR2 = Range("J" & Rows.Count).End(xlUp).Row
    For i2 = 1 To LR2
        If Range("K" & i2) = "" Then
            Range("K" & i2) = Range("J" & i2)
        End If
    Next i2
        
    
    ' 13.8 Fix hyphens in PO Box Numbers
    Dim lngLastRow As Long
    Dim rngCell As Range
    
    If WorksheetFunction.CountA(Cells) > 0 Then
        'Find the last row from columns H to K (inclusive)
        lngLastRow = Range("H:K").Find("*", SearchOrder:=xlByRows, searchDirection:=xlPrevious).Row
    Else
        'MsgBox "There is no data on """ & ActiveSheet.Name & """ to work with!!", vbInformation, "Data Editor"
        'Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    For Each rngCell In Range("H2:H" & lngLastRow)
    
        'If the first character of Col H is 'P', then...
        If StrConv(Left(rngCell.Value, 1), vbUpperCase) = "P" Then
            '...replace any hyphens in the text with a space (change to suit)
            If InStr(rngCell.Value, "-") > 0 Then
                Do Until rngCell.Find("-") Is Nothing
                    rngCell.Replace What:="-", Replacement:=""
                Loop
            End If
        End If
        'If there's no entry in Col K, then...
        If Len(rngCell.Offset(0, 3).Value) = 0 Then
            '...put the value in Col J in it.
            rngCell.Offset(0, 3).Value = rngCell.Offset(0, 2).Value
        End If
        
    Next rngCell