Data Adjustment

[prasad.vanka]

Hi,

I have a worksheet with 5 address columns (Addr, Addr2, Addr3, Addr4
and Addr5) with values populated. There are some rows with values in
all the cells and some with values in only few columns.

Overall this sheet has 9000 rows.

My task is to go through each row and see if the filled cells are in
order. If not for eg., addr1 has value, addr2 hasn't and then addr3 has
then I will have to move addr3 to addr4.

Finally my sheet will have rows with address details in consecutive
cells without any gaps or empty cells in between.

Can someone please tell me a quick way to achieve this.

I guess I might need to use sorting but right now I can't figure it out
how do I do this.

Thanks & Regards
Prasad

 

[Tom Ogilvy]

Why would you move addr3 to addr4 (what is in addr5 - does that make a
difference)> You need to state what your rule is because it doesn't make
much sense as shown. Assume 4 cells are filled, which single cell should be
blank. If 3 cells are filled, which two cells should be blank.

If addr1 and addr2 were empty and addr 3 - 5 were filled, should anything be
moved? So again, what is the rule you use.

 

[prasad.vanka]

Hi Tom,

I am sorry I made a mistake. I will move addr3 to addr2 if addr1 has
value, addr2 is blank and addr3 has value. Once addr3 is moved to addr2
I will also check addr4 and addr5 and do the same till I get all the
address values in consecutive cells.

By the end of the exercise what I want is that all the address details
should be in consecutive cells without any blanks.

One more eg:
Suppose addr1 has value, addr2 hasn't, addr3 hasn't, addr4 has and
addr5 has values then in total 3 cells have values. Then I want all the
values in consecutive cells. My result would be that addr1, addr2 and
addr3 will have values and addr4 and addr5 will be blank.

I hope I have explained what I want now.
Thanks & Regards,
Prasad

 

[Herbert]

Hello,

what worked for me was:
1) Select the whole list
2) Edit => Go To => Special => Blanks
3) Edit => Delete => Shift cells left

I haven't tried this with a huge list, but you should be safe.

Regards,
Herbert

 

[Rob]

maybe you could try something like this:

for rownumber=FirstRow to LastRow
for columnnumber=FirstColumn to Lastcolumn
if cells(rownumber,columnnumber)=0 then
cells(rownumber,columnnumber).delete
end if
next
next

 

[sbakker]

Well this is how I would do it quick and dirty


Code:
--------------------
Sub RmvBlanks()
Dim rngMyRange As Range
Dim rngCurRow As Range
Dim lCount, lInnerCount As Long
Dim lColumns As Long


Set rngMyRange = Selection
lColumns = rngMyRange.Columns.Count
'Loop through each row of selection
For Each rngCurRow In rngMyRange.Rows
lInnerCount = 1
'Loop through each column of the current row
For lCount = 1 To lColumns
'If Cell is no empty copy the value to the next open cell from the left
If rngCurRow.Columns(lCount) <> vbNullString Then
rngCurRow.Columns(lInnerCount) = rngCurRow.Columns(lCount)
If lInnerCount <> lCount Then
rngCurRow.Columns(lCount) = ""
End If
lInnerCount = lInnerCount + 1
End If
Next lCount
Next rngCurRow
End Sub

 

[Tom Ogilvy]

I don't see any problem with Herbert's suggestion as long as there will not
be greater than 8190 separate areas (discontiguous cell/range/area
references).

It should handle 3276 rows at a minimum (worst case).

so it could be done in 3 increments

for i = 1 to 9000 step 3200
set rng = cells(i,1).Resize(3200,5)
set rng1 = nothing
On error resume next
set rng1 = rng.specialcells(xlblanks)
On error goto 0
if not rng1 is nothing then
rng1.Delete Shift:=xlShiftToLeft
end if
Next

 

[prasad.vanka]

Thanks Guys for all the answers.

Regards
Prasad Vanka

Well this is how I would do it quick and dirty


Code:
--------------------
Sub RmvBlanks()
Dim rngMyRange As Range
Dim rngCurRow As Range
Dim lCount, lInnerCount As Long
Dim lColumns As Long


Set rngMyRange = Selection
lColumns = rngMyRange.Columns.Count
'Loop through each row of selection
For Each rngCurRow In rngMyRange.Rows
lInnerCount = 1
'Loop through each column of the current row
For lCount = 1 To lColumns
'If Cell is no empty copy the value to the next open cell from the left
If rngCurRow.Columns(lCount) <> vbNullString Then
rngCurRow.Columns(lInnerCount) = rngCurRow.Columns(lCount)
If lInnerCount <> lCount Then
rngCurRow.Columns(lCount) = ""
End If
lInnerCount = lInnerCount + 1
End If
Next lCount
Next rngCurRow
End Sub
--------------------


--
sbakker
------------------------------------------------------------------------
sbakker's Profile: http://www.excelforum.com/member.php?action=getinfo&userid=23645
View this thread:

http://www.excelforum.com/showthread.php?threadid=373072