Moving data if cell is empty

  • Thread starter Thread starter Ed Peters
  • Start date Start date
E

Ed Peters

Hi,

I have a x rows of 5 fields (name and home addresses)

The first 2 fields must have data.

How would I check if the first 2 fields have data and if not check
fields 3,4 and 5 for data and if exits move them to the fields 1 or 2.

Also if fields 1 and 2 have data and field 3 is empty move field 4 or
5 to field 3.

Hope that makes sense...

Thanks,

Ed
 
try this

Sub checkaddress()

LastRowA = Cells(Rows.Count, "A").End(xlUp).Row
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
LastRowC = Cells(Rows.Count, "C").End(xlUp).Row
LastRowD = Cells(Rows.Count, "D").End(xlUp).Row
LastRowE = Cells(Rows.Count, "E").End(xlUp).Row

LastRow = LastRowA
If LastRowB > LastRow Then
LastRow = LastRowB
End If
If LastRowC > LastRow Then
LastRow = LastRowC
End If
If LastRowD > LastRow Then
LastRow = LastRowD
End If
If LastRowE > LastRow Then
LastRow = LastRowE
End If

For RowCount = 1 To LastRow

If Not IsEmpty(Cells(RowCount, "A")) Then

If Not IsEmpty(Cells(RowCount, "B")) Then

'A & B have data
'check c for data
If IsEmpty(Cells(RowCount, "C")) Then

'A & B have data and C is empty
If Not IsEmpty(Cells(RowCount, "D")) Then
Cells(RowCount, "C") = _
Cells(RowCount, "D")
Cells(RowCount, "D").ClearContents
Else
If Not IsEmpty(Cells(RowCount, "E")) Then
Cells(RowCount, "C") = _
Cells(RowCount, "E")
Cells(RowCount, "E").ClearContents
End If
End If
End If
Else
'A has data and B is empty
If Not IsEmpty(Cells(RowCount, "C")) Then
Cells(RowCount, "B") = _
Cells(RowCount, "C")
Cells(RowCount, "C").ClearContents
Else
If Not IsEmpty(Cells(RowCount, "D")) Then
Cells(RowCount, "B") = _
Cells(RowCount, "D")
Cells(RowCount, "D").ClearContents
Else
If Not IsEmpty(Cells(RowCount, "E")) Then
Cells(RowCount, "B") = _
Cells(RowCount, "E")
Cells(RowCount, "E").ClearContents
End If
End If
End If
End If
Else
If Not IsEmpty(Cells(RowCount, "B")) Then

'A is empty and B has data
If Not IsEmpty(Cells(RowCount, "C")) Then
Cells(RowCount, "A") = _
Cells(RowCount, "B")
Cells(RowCount, "B") = _
Cells(RowCount, "C")
Cells(RowCount, "C").ClearContents
Else
If Not IsEmpty(Cells(RowCount, "D")) Then
Cells(RowCount, "A") = _
Cells(RowCount, "B")
Cells(RowCount, "B") = _
Cells(RowCount, "D")
Cells(RowCount, "D").ClearContents
Else
If Not IsEmpty(Cells(RowCount, "E")) Then
Cells(RowCount, "A") = _
Cells(RowCount, "B")
Cells(RowCount, "B") = _
Cells(RowCount, "E")
Cells(RowCount, "E").ClearContents
End If
End If
End If
End If
End If
Next RowCount

End Sub
 
I didn't like my last macro I sent you. The code was too hard to follow. I
went looking for a more eligant method. Came up with a table driven version
of the macro. Let me know which you think is better.


Sub checkaddress()

Dim CellValue(8) As Variant
Dim MovedCell(8) As Variant

'Table of data in cells
'F = Full, E = empty, X= Don't Care
CellValue(0) = Array("F", "F", "E", "F", "X")
CellValue(1) = Array("F", "F", "E", "E", "F")
CellValue(2) = Array("F", "E", "F", "X", "X")
CellValue(3) = Array("F", "E", "E", "F", "X")
CellValue(4) = Array("F", "E", "E", "E", "F")
CellValue(5) = Array("E", "F", "F", "X", "X")
CellValue(6) = Array("E", "F", "E", "F", "X")
CellValue(7) = Array("E", "F", "E", "E", "F")

'Array of showing column data is move to
'X = Don't move
'A - E letter of column where data was move from
'Array represents columns A to E where data is move to
'First array member is column A, last is E
MovedCell(0) = Array("X", "X", "D", "X", "X")
MovedCell(1) = Array("X", "X", "E", "X", "X")
MovedCell(2) = Array("X", "C", "X", "X", "X")
MovedCell(3) = Array("X", "D", "X", "X", "X")
MovedCell(4) = Array("X", "E", "X", "X", "X")
MovedCell(5) = Array("B", "C", "X", "X", "X")
MovedCell(6) = Array("B", "D", "X", "X", "X")
MovedCell(7) = Array("B", "E", "X", "X", "X")

LastRowA = Cells(Rows.Count, "A").End(xlUp).Row
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
LastRowC = Cells(Rows.Count, "C").End(xlUp).Row
LastRowD = Cells(Rows.Count, "D").End(xlUp).Row
LastRowE = Cells(Rows.Count, "E").End(xlUp).Row

LastRow = LastRowA
If LastRowB > LastRow Then
LastRow = LastRowB
End If
If LastRowC > LastRow Then
LastRow = LastRowC
End If
If LastRowD > LastRow Then
LastRow = LastRowD
End If
If LastRowE > LastRow Then
LastRow = LastRowE
End If

For RowCount = 1 To LastRow
For TableCount = 0 To (UBound(CellValue, 1) - 1)

found = True

For ColOff = 0 To 4
If CellValue(TableCount)(ColOff) <> _
"X" Then

If CellValue(TableCount)(ColOff) = _
"F" Then

'table says cell if full but it is empty
If IsEmpty(Cells(RowCount, "A"). _
Offset(0, ColOff)) Then

found = False
Exit For
End If
Else
'table says cell if empty but it is full
If Not IsEmpty(Cells(RowCount, "A"). _
Offset(0, ColOff)) Then

found = False
Exit For
End If
End If
End If
Next ColOff

If found = True Then
For ColOff = 0 To 4

If MovedCell(TableCount)(ColOff) _
<> "X" Then

Cells(RowCount, "A"). _
Offset(0, ColOff) = _
Cells(RowCount, _
MovedCell(TableCount)(ColOff))
Cells(RowCount, _
MovedCell(TableCount)(ColOff)). _
ClearContents
End If
Next ColOff
End If
Next TableCount
Next RowCount
End Sub
 
I think toooooo much. I figure a way to have only one table rather than two
in my previous posting. Let me know which of the 3 methods you think is the
best


Sub checkaddress()

Dim MovedCell(8) As Variant


'Table of data in cells
'Columns of MovedCell represent
'columns A - E in spreadsheet
'+ = Cell is Full
'- = Cell is Empty
'A - E = Move data from this column
'""= Don't Care
MovedCell(0) = Array("+", "+", "-D", "+", "")
MovedCell(1) = Array("+", "+", "-E", "", "+")
MovedCell(2) = Array("+", "-C", "+", "", "")
MovedCell(3) = Array("+", "-D", "", "+", "")
MovedCell(4) = Array("+", "-E", "", "", "+")
MovedCell(5) = Array("-B", "+C", "+", "", "")
MovedCell(6) = Array("-B", "+D", "", "+", "")
MovedCell(7) = Array("-B", "+E", "", "", "+")


LastRowA = Cells(Rows.Count, "A").End(xlUp).Row
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
LastRowC = Cells(Rows.Count, "C").End(xlUp).Row
LastRowD = Cells(Rows.Count, "D").End(xlUp).Row
LastRowE = Cells(Rows.Count, "E").End(xlUp).Row

LastRow = LastRowA
If LastRowB > LastRow Then
LastRow = LastRowB
End If
If LastRowC > LastRow Then
LastRow = LastRowC
End If
If LastRowD > LastRow Then
LastRow = LastRowD
End If
If LastRowE > LastRow Then
LastRow = LastRowE
End If

For RowCount = 1 To LastRow
For TableCount = 0 To (UBound(MovedCell, 1) - 1)

found = True

For ColOff = 0 To 4
If MovedCell(TableCount)(ColOff) <> _
"" Then

If Left(MovedCell(TableCount)(ColOff), 1) = _
"+" Then

'table says cell if full but it is empty
If IsEmpty(Cells(RowCount, "A"). _
Offset(0, ColOff)) Then

found = False
Exit For
End If
Else
'table says cell if empty but it is full
If Not IsEmpty(Cells(RowCount, "A"). _
Offset(0, ColOff)) Then

found = False
Exit For
End If
End If
End If
Next ColOff

If found = True Then
For ColOff = 0 To 4

If Len(MovedCell(TableCount)(ColOff)) _
= 2 Then

Cells(RowCount, "A"). _
Offset(0, ColOff) = _
Cells(RowCount, _
Mid(MovedCell(TableCount)(ColOff), 2, 1))
Cells(RowCount, _
Mid(MovedCell(TableCount)(ColOff), 2, 1)). _
ClearContents
End If
Next ColOff
End If
Next TableCount
Next RowCount
End Sub
 
I think toooooo much. I figure a way to have only one table rather than two
in my previous posting. Let me know which of the 3 methods you think is the
best

Sub checkaddress()

Dim MovedCell(8) As Variant

'Table of data in cells
'Columns of MovedCell represent
'columns A - E in spreadsheet
'+ = Cell is Full
'- = Cell is Empty
'A - E = Move data from this column
'""= Don't Care
MovedCell(0) = Array("+", "+", "-D", "+", "")
MovedCell(1) = Array("+", "+", "-E", "", "+")
MovedCell(2) = Array("+", "-C", "+", "", "")
MovedCell(3) = Array("+", "-D", "", "+", "")
MovedCell(4) = Array("+", "-E", "", "", "+")
MovedCell(5) = Array("-B", "+C", "+", "", "")
MovedCell(6) = Array("-B", "+D", "", "+", "")
MovedCell(7) = Array("-B", "+E", "", "", "+")

LastRowA = Cells(Rows.Count, "A").End(xlUp).Row
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
LastRowC = Cells(Rows.Count, "C").End(xlUp).Row
LastRowD = Cells(Rows.Count, "D").End(xlUp).Row
LastRowE = Cells(Rows.Count, "E").End(xlUp).Row

LastRow = LastRowA
If LastRowB > LastRow Then
LastRow = LastRowB
End If
If LastRowC > LastRow Then
LastRow = LastRowC
End If
If LastRowD > LastRow Then
LastRow = LastRowD
End If
If LastRowE > LastRow Then
LastRow = LastRowE
End If

For RowCount = 1 To LastRow
For TableCount = 0 To (UBound(MovedCell, 1) - 1)

found = True

For ColOff = 0 To 4
If MovedCell(TableCount)(ColOff) <> _
"" Then

If Left(MovedCell(TableCount)(ColOff), 1) = _
"+" Then

'table says cell if full but it is empty
If IsEmpty(Cells(RowCount, "A"). _
Offset(0, ColOff)) Then

found = False
Exit For
End If
Else
'table says cell if empty but it is full
If Not IsEmpty(Cells(RowCount, "A"). _
Offset(0, ColOff)) Then

found = False
Exit For
End If
End If
End If
Next ColOff

If found = True Then
For ColOff = 0 To 4

If Len(MovedCell(TableCount)(ColOff)) _
= 2 Then

Cells(RowCount, "A"). _
Offset(0, ColOff) = _
Cells(RowCount, _
Mid(MovedCell(TableCount)(ColOff), 2, 1))
Cells(RowCount, _
Mid(MovedCell(TableCount)(ColOff), 2, 1)). _
ClearContents
End If
Next ColOff
End If
Next TableCount
Next RowCount
End Sub






















- Show quoted text -
Click to expand...

Thanks Joel, Great stuff. Works a treat. The last one was my
preference.

Ed
 
You must log in or register to reply here.

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

A data validation question 1
VBA set thick borders around non empty cells in range 0
Pivot table custom/calculated field? 4
remembering the same filtering criteria 13
User input from excel form not populating Access Database 3
Is it possible to just act on the filtered data 2
move data w/o blank data to another sheet 1
Formula or code? 4

Back
Top