Complex file merging, step one: fill empty cells with cells from another column.

[Robkg]

First, I'm sorry that I'm a n00b and might have posted this in the wrong section, also did I use the search but still might have posted a question that has been posted (and answered) before. My sincere apologies for this if it is the case, please let me know if so.

I'm trying to create a VBA code to help my father with merging 10 data files with addresses (they are coming from different sources), de-double these and remove addresses from a blacklist file. This has to be done every 3 weeks, that's why I'm trying to automate it.

Step one is getting all the data together in one file. That's working almost fine. The issue is with the address columns.

The columns are following:

Data	Company	Visiting			Postal
Source	Name	Street	Zip code	City	Street/PO	Zip code	City

Not all companies have a postal box, so we want to fill those blanks with the visiting address (and in the end remove the column with the visiting address data).

So if for row 251 the postal data is unknown, cells F251:H251 will be empty and have to be filled with C251:E251. The data will be different every time, so I'd like to find the empty cells and copy the cells from the left.

Of course did I look for a code, and I found the one below, it seems to do what I want, but I'm failing in modifying it to my own file.

Private Sub CommandButton2_Click()


Dim cel As Range, rngFind As Range, rngFilter As Range
Dim wks As Worksheet


Set wks = Sheets("sheet2")


With wks


    '-> Error check to make sure "blanks" exist
    Set rngFind = .Range("F1:F" & .Range("B" & Rows.Count).End(xlUp).Row).Find("", lookat:=xlWhole)


    If Not rngFind Is Nothing Then


        Set rngFilter = .Range("F1:F" & .Range("A" & Rows.Count).End(xlUp).Row)


        rngFilter.AutoFilter 1, "="


        '-> Error check to make sure "assigned" exists for blank cells
        Set rngFind = .Columns("B:B").SpecialCells(xlCellTypeVisible).Find("*", lookat:=xlWhole)


        If Not rngFind Is Nothing Then
        '-> okay, it exists. filter and loop through cells


            rngFilter.AutoFilter 2, "*"


            Set rngFind = Intersect(.UsedRange, .UsedRange.Offset(1), .Columns(1)).SpecialCells(xlCellTypeVisible)


            For Each cel In rngFind


                If cel.Offset(0, 1).Value = "*" Then cel.Value = Range("C:E")


            Next cel


        End If


    End If


End With




End Sub

[astranberg]

I don't know where your stuff is located, but I would do something like this:

Sub Test1()
    For r = 2 To Range("D1048576").End(xlUp).Row    ' blank cells are in column D, header at row 1
        If Cells(r, 4).Value = "" Then              ' If cell is blank
            Cells(r, 4).Value = Cells(r, 7).Value   ' Other zip is in column G
        End If
    Next r
End Sub

[Robkg]

I don't know where your stuff is located, but I would do something like this:

Sub Test1()
    For r = 2 To Range("D1048576").End(xlUp).Row    ' blank cells are in column D, header at row 1
        If Cells(r, 4).Value = "" Then              ' If cell is blank
            Cells(r, 4).Value = Cells(r, 7).Value   ' Other zip is in column G
        End If
    Next r
End Sub

Somehow do I fail in getting this code to work.

I added an example file to show the structure of the file. The columns D, E and F will have to be removed in the end.
Example2.xlsx

[SamT]

Sub SamT()
Dim r As Long
    For r = 2 To Range("G" & Rows.Count).End(xlUp).Row 'G = postbus_adres, header at row 1
        If Cells(r, 7).Value = "" Then ' If cell is blank
            Range(Cells(r, 7), Cells(r, 9)).Value = Range(Cells(r, 4), Cells(r, 6)).Value
        End If
    Next r
    Range("D:F").Delete
End Sub

[Robkg]

Sub SamT()
Dim r As Long
    For r = 2 To Range("G" & Rows.Count).End(xlUp).Row 'G = postbus_adres, header at row 1
        If Cells(r, 7).Value = "" Then ' If cell is blank
            Range(Cells(r, 7), Cells(r, 9)).Value = Range(Cells(r, 4), Cells(r, 6)).Value
        End If
    Next r
    Range("D:F").Delete
End Sub

This works perfect! Thank you very much.

[SamT]

I just adapted Robkg's code to your specific workbook.