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
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