PDA

View Full Version : [SOLVED] Complex file merging, step one: fill empty cells with cells from another column.



Robkg
11-04-2013, 08:15 AM
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
11-04-2013, 09:38 AM
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
11-06-2013, 04:07 AM
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.
10791

SamT
11-06-2013, 05:27 AM
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
11-06-2013, 05:54 AM
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
11-06-2013, 04:18 PM
I just adapted Robkg's code to your specific workbook.