Select Cell X, Filter cell Y, if cell Y meets condition Z -> Input into cell X

[Palon]

Dear All,

Please see below (treat __ as space):

| NO-6514 rs,soKristiansund__ | __________|
| Aspx CH-1024 Ecublens____ |Switzerland_ |
| CH-1009 Ajuhal Pully ______ |___________|
| Sumthin DK-3660 Stenløse_ | Denmark__ |
| Himmhs AT-4724 Neukirchen |__________ |
| Trololo NL-8442 BZ HEE____ | Netherlands |
| AT-3500 Krems Smpffr_____ |__________ |


What I am trying to overcome is making a fragment of a code that does the following:


1. Out of a single column with different text values - select only cells with no value (blank)

2. Select cells with offset (0, -1) to each cell selected in 1.

3. See if cells selected in 2. contain a phrase eg. "AT-" (data in cell would contain several alphanumerical words).

4. For every selected cell in 2. which meets condition in 3. - input text value eg. "Austria" into corresponding blank cell from 1.
offset ( 0, +1)

In short - I want the code to look up blanks and fill them in with country name. Only for "AT-" and "Austria".

Help is deeply appreciated. Thank you.

[p45cal]

If the cells are truly blank cells then the following will work (pay attention to the first comment in the code):

Sub blah()
'first select a single cell in the column containing blanks you want to replace.
For Each cll In Intersect(ActiveCell.EntireColumn, ActiveSheet.UsedRange).SpecialCells(xlCellTypeBlanks).Cells ' this line will error i there are no blank cells at all.
  If InStr(1, cll.Offset(, -1).Value, "AT-", vbTextCompare) > 0 Then cll.Value = "Austria"
Next
End Sub

If the cells are not truly balnk but in fact contain only spaces then this will work:

Sub blah2()
'first select a single cell in the column containing blanks you want to replace.
For Each cll In Intersect(ActiveCell.EntireColumn, ActiveSheet.UsedRange).Cells
  If Application.Trim(cll.Value) = "" Then
    If InStr(1, cll.Offset(, -1).Value, "AT-", vbTextCompare) > 0 Then cll.Value = "Austria"
  End If
Next
End Sub

[Palon]

Dear p45cal,

My apologies for late reply. I have just now tested your advice and it works perfectly.

You have been of great help. Thank you!

Regards,
Palon