How to check a range of cells is empty?

  • Thread starter Thread starter serdar
  • Start date Start date
S

serdar

This checks if 3 cells of the range Target is empty.

If Len(Target.Cells(1, 1)) = 0 and Len(Target.Cells(1, 2)) = 0 and
Len(Target.Cells(1, 3)) = 0

How to write this with a single test expression?
I need this because i am gonna check it from column 1 to x, not column 1 to
3.
 
Hi serdar,

Try this:

Sub test()
If Application.CountA(Target) Then MsgBox "Hello"
End Sub


Regards,
KL
 
This should work either, right?

Sub test()
If Application.CountA( Target.Range( Cells(1,1),Cells(1,x) ) )
Then MsgBox "Hello"
End Sub

How copy a range to another range in this manner (single line expression)?

Thank you.
 
If Application.CountA(target.Resize(, 3)) = 0 Then
MsgBox "empty"
End If

just change the 3 to suit

--

HTH

RP
(remove nothere from the email address if mailing direct)
 
Just to know, CountA seems to be a member of WorksheetFunction class not
Application. Why did u use Application.CountA ?
 
Hi,

Sorry, my first attempt of reply to this went to your private e-mail. So
here is another try:

This makes no sense to me: Target.Range( Cells(1,1),Cells(1,x) )
What are you trying to do? Maybe Bob Phillips has already provided the
solution you are after (below)

Regards,
KL
 
Target.Range( Cells(1,1),Cells(1,x) )

Lets say user selects a range of 1 row height and 8 col widht. I want to
test if this range's 3rd to 8th cell is empty or not as:

Target.Range( Cells(1,3),Cells(1,8) )

Don't bother it works fine. Can you tell me how to copy a range to another
one? Is this ok:

Range(a1:a8) = Range(c1:c8)

Thanks.
 
I am sending the code i work on, if u are interested. This version dont work
properly cos i am simplifying the code and adding some constants etc.

It basically distributes the records from the main worksheet to appropriate
ones.



Public undoing As Boolean
Public selectedCode As String
Public selectedRow As String
Const RTOTALCELL = "L2"
Const COLTOTAL = 7
Const HEADERH = 2

Const CRECNO = 1
Const CREMAINDER = 7
Const CCODE = 2
Const COLDATE = 3
Const CDEBT = 5
Const CCREDIT = 6






Private Sub Worksheet_Activate()
Application.CellDragAndDrop = True
undoing = False
End Sub
Private Sub Worksheet_Deactivate()
Application.CellDragAndDrop = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Dim m As Long

'trying.. this will be cleared
Range("c10") = Application.CountA(Range(Cells(5, 1), Cells(5, 5)))




Exit Sub




If undoing Then Exit Sub





'Blocks changes with multiple cells except a deletion of a whole record
If Not undoing And (Target.Columns.Count > 1 Or Target.Rows.Count > 1 Or
(Target.Column = CRECNO And Target.Row > HEADERH) Or (Target.Column =
Range(RTOTALCELL).Column And Target.Row = Range(RTOTALCELL).Row)) Then


If Target.Columns.Count = COLTOTAL - 1 And Target.Rows.Count = 1 And
Application.CountA(Range(Cells(1, 2), Cells(1, COLTOTAL))) = 0 Then

undoing = 1
Call DeleteRecord(Target, selectedCode, findRecord(selectedCode,
Cells(Target.Row, CRECNO)))
Cells(selectedRow - 1, CREMAINDER).AutoFill
Range(Cells(selectedRow - 1, CREMAINDER), Cells(Range(RTOTALCELL).Value +
HEADERH, CREMAINDER)), xlFillDefault
undoing = 0
Exit Sub
End If

MsgBox "Hatalý iþlem."
undoing = 1
Application.Undo
undoing = 0
Exit Sub
End If

If Target.Column = CCODE Then
'Checks if the worksheet exists
If Not sheetExists(Target) Then
MsgBox "Hatalý kod."
undoing = 1
Application.Undo
undoing = 0
Exit Sub
End If
End If


m = Range(RTOTALCELL).Value + HEADERH + 1

If Target.Column < COLTOTAL And Target.Row < m And Target.Row > HEADERH
Then

If Cells(Target.Row, CRECNO) < 1 Then

If Len(Cells(Target.Row, 2)) > 0 And Len(Cells(Target.Row, 3)) >
0 And Len(Cells(Target.Row, 4)) > 0 And (Len(Cells(Target.Row, 5)) > 0 Or
Len(Cells(Target.Row, 6)) > 0) Then
undoing = 1
Call AddNewRecord(Cells(Target.Row, CCODE).Value,
Worksheets(Cells(Target.Row, CCODE).Value).Range(RTOTALCELL).Value + HEADERH
+ 1, Target.Row)
Cells(Target.Row - 1, CREMAINDER).AutoFill
Range(Cells(Target.Row - 1, CREMAINDER), Cells(m - 1, CREMAINDER)),
xlFillDefault
undoing = 0
End If
Exit Sub

End If


If Target.Column = CCODE Then
undoing = 1
Call MoveRecord(Target)
undoing = 0
Exit Sub
End If


'Updates the existing record on the matching worksheet as well
undoing = 1
Call UpdateRecord(Target, Cells(Target.Row, CCODE).Value)
undoing = 0
End If



If Len(Cells(m, COLDATE)) = 0 Then _
Exit Sub

'Adds a new record
If Len(Cells(m, 2)) > 0 And Len(Cells(m, 4)) > 0 And (Len(Cells(m, 5)) >
0 Or Len(Cells(m, 6)) > 0) Then

undoing = 1
Call AddNewRecord(Cells(m, CCODE).Value, Worksheets(Cells(m,
CCODE).Value).Range(RTOTALCELL).Value + HEADERH + 1, m)
undoing = 0

End If

End Sub






Public Sub AddNewRecord(ByVal b As String, ByVal t As Long, ByVal m As Long)

Dim x, newrecordno As Long
Dim myRange As Range

Worksheets(b).Range(Worksheets(b).Cells(t, 1), Worksheets(b).Cells(t,
COLTOTAL)).Insert Shift:=xlDown
Worksheets(b).Range(Worksheets(b).Cells(t, 1), Worksheets(b).Cells(t,
COLTOTAL)).Font.FontStyle = "Normal"


Worksheets(b).Cells(t, 1) = Cells(m, 1)
Worksheets(b).Cells(t, 2) = Cells(m, 2)
Worksheets(b).Cells(t, 3) = Cells(m, 3)
Worksheets(b).Cells(t, 4) = Cells(m, 4)

If Len(Cells(m, CDEBT)) > 0 Then
Worksheets(b).Cells(t, CCREDIT) = Cells(m, CDEBT)
Else
Worksheets(b).Cells(t, CDEBT) = Cells(m, CCREDIT)
End If


Range(RTOTALCELL).Value = Range(RTOTALCELL).Value + 1
Worksheets(b).Range(RTOTALCELL).Value =
Worksheets(b).Range(RTOTALCELL).Value + 1


'Finds the smallest possible record number for the new record
For x = 1 To Range(RTOTALCELL).Value + HEADERH + 1

Set myRange = Range(Cells(HEADERH + 1, CRECNO),
Cells(Range(RTOTALCELL).Value + 13, CRECNO)).Find(x, LookIn:=xlValues)

If myRange Is Nothing Then
newrecordno = x
Exit For
End If

Next x


Cells(m, CRECNO) = newrecordno
Worksheets(b).Cells(t, CRECNO) = newrecordno



End Sub

Public Sub MoveRecord(ByVal Target As Range)

Dim j, sheetindex, rowindex As Long
Dim found As Boolean
Dim mySheet As Worksheet

'Finds the matching record
For Each mySheet In Worksheets

For j = 1 To mySheet.Range(RTOTALCELL)

If mySheet.Index > 1 And mySheet.Cells(j + 2, 1) =
Cells(Target.Row, 1) Then
found = 1
sheetindex = mySheet.Name
rowindex = j + 2
Exit For
End If
Next j


If found = 1 Then
found = 0
Exit For
End If

Next mySheet



'Moves the record to the matching worksheet and deletes it from the
existing one
If Not Worksheets(sheetindex).Name = Target.Value Then


Worksheets(Target.Value).Cells(Worksheets(Target.Value).Range(RTOTALCELL) +
3, 1) = Cells(Target.Row, 1)

Worksheets(Target.Value).Cells(Worksheets(Target.Value).Range(RTOTALCELL) +
3, 2) = Cells(Target.Row, 2)

Worksheets(Target.Value).Cells(Worksheets(Target.Value).Range(RTOTALCELL) +
3, 3) = Cells(Target.Row, 3)

Worksheets(Target.Value).Cells(Worksheets(Target.Value).Range(RTOTALCELL) +
3, 4) = Cells(Target.Row, 4)

Worksheets(Target.Value).Cells(Worksheets(Target.Value).Range(RTOTALCELL) +
3, 5) = Cells(Target.Row, 6)

Worksheets(Target.Value).Cells(Worksheets(Target.Value).Range(RTOTALCELL) +
3, 6) = Cells(Target.Row, 5)

Worksheets(Target.Value).Range(RTOTALCELL) =
Worksheets(Target.Value).Range(RTOTALCELL) + 1


Worksheets(sheetindex).Range(Worksheets(sheetindex).Cells(rowindex,
1), Worksheets(sheetindex).Cells(rowindex, COLTOTAL - 1)).Delete Shift:=xlUp
Worksheets(sheetindex).Range(RTOTALCELL) =
Worksheets(sheetindex).Range(RTOTALCELL) - 1





End If




End Sub

Public Sub UpdateRecord(ByVal Target As Range, ByVal b As String)

Dim x As Long


x = findRecord(b, Cells(Target.Row, 1).Value)

If Len(Cells(Target.Row, 3)) = 0 And Len(Cells(Target.Row, 4)) = 0 And
Len(Cells(Target.Row, 5)) = 0 And Len(Cells(Target.Row, 6)) = 0 Then
Call DeleteRecord(Target, b, x)
Exit Sub
End If

Select Case Target.Column
Case Is = CDEBT
Worksheets(b).Cells(x, CCREDIT) = Target
Case Is = CCREDIT
Worksheets(b).Cells(x, CDEBT) = Target
Case Else
Worksheets(b).Cells(x, Target.Column) = Target
End Select


End Sub
Public Sub DeleteRecord(ByVal Target As Range, ByVal b As String, myRow As
Long)

Worksheets(b).Range(Worksheets(b).Cells(myRow, 1),
Worksheets(b).Cells(myRow, COLTOTAL)).Delete Shift:=xlUp

Range(Cells(Target.Row, 1), Cells(Target.Row, COLTOTAL)).Delete
Shift:=xlUp


Worksheets(b).Range(RTOTALCELL) = Worksheets(b).Range(RTOTALCELL) - 1
Range(RTOTALCELL).Value = Range(RTOTALCELL).Value - 1


MsgBox "Kayýt silindi."



End Sub

Public Function sheetExists(ByVal n As String)

Dim mySheet As Worksheet


For Each mySheet In Worksheets
If mySheet.Name = n Then
sheetExists = True
Exit Function
End If
Next mySheet


sheetExists = False

End Function

Public Function findRecord(b As String, recordindex As Long)

Dim c, x As Long

c = 1
x = 3
Do While c > 0

If Worksheets(b).Cells(x, CRECNO) = "" Then _
c = 0

If Worksheets(b).Cells(x, CRECNO) = recordindex Then
findRecord = x
Exit Function
End If

x = x + 1

Loop

End Function





Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Columns.Count = COLTOTAL - 1 And Target.Rows.Count = 1 Then
selectedCode = Cells(Target.Row, CCODE)
selectedRow = Target.Row
End If
End Sub
 
KL,

Target.Range( Cells(1,1),Cells(1,x) ) refers to the range from Cells( 1, 1)
to Cells( 1, x) within range Target. It's the top x row of cells in range
Target. If the target is E5:G20 and x is 5, it will refer to E5:I5.
 
Hi Earl,

Thanks for the tip, but I do understand all that :-) My doubt was wheather
the OP wanted to evaluate all the cells of the target range one-by-one or to
use only some of the cells. If the second was true, then there will be a
need to handle the situations whereby the number of columns is not as
expected (one way is what Bob suggested). But it is up to the OP to clarify
how should this be handled.

Regards,
KL
 
Back
Top