Moving data if cell is empty
On Sep 11, 12:20 pm, Joel wrote:
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
"Joel" wrote:
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
"Joel" wrote:
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
"Ed Peters" wrote:
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- Hide quoted text -
- Show quoted text -
Thanks Joel, Great stuff. Works a treat. The last one was my
preference.
Ed
|