Skipping over empty cells problem, HELP!

Question

Currently I am using this code:

Sub Button2_Click()

Dim R As Range

Dim FileName As Variant

Set R = Range("C" & Rows.Count).End(xlUp).Offset(1)

R = Range("A1").Text

FileName = Application.GetOpenFilename( _

"Pictures (*.jpg;*.bmp;*.gif;*.png),*.jpg;*.bmp;*.gif;*.png", 1, "Select Picture to insert", _

"Insert", False)

If VarType(FileName) = vbBoolean Then Exit Sub

InsertPicture FileName, R.Offset(, 2)

End Sub

Private Function InsertPicture(ByVal FName As String, ByVal Where As Range, _

Optional ByVal LinkToFile As Boolean = False, _

Optional ByVal SaveWithDocument As Boolean = True, _

Optional ByVal LockAspectRatio As Boolean = True) As Shape

Dim S As Shape, SaveScreenUpdating, SaveCursor

SaveCursor = Application.Cursor

SaveScreenUpdating = Application.ScreenUpdating

Application.Cursor = xlWait

Application.ScreenUpdating = False

With Where

Set S = Where.Parent.Shapes.AddPicture( _

FName, LinkToFile, SaveWithDocument, .Left, .Top, -1, -1)

S.LockAspectRatio = LockAspectRatio

S.Width = .Width

If S.Height > .Height Or Not LockAspectRatio Then S.Height = .Height

End With

Set InsertPicture = S

Application.Cursor = SaveCursor

Application.ScreenUpdating = SaveScreenUpdating

End Function

The problem is the bolded area. The thing is that I have a database, so basically when I want to add something new to it, I would like to add the value of cell A1 to the next available cell in column C and a picture in that same row but in column E. So the current code works perfectly, except the fact that it skips over cells!

Lets say that cells C7,C8,C9, and C11 are all filled. When I use this macro it will to it will put the value of A1 into cell C12 and the picture into E12. BUT WHAT ABOUT C10 and E10! This is what I meant by the bolded area of the VBA, it skips over cells/rows.

How can I change it and/or fix it to STOP this skipping of rows/cell?

I would really appreciate the help,

Thank you!

Answer 1

Hi,

No need to loop...

The first empty cell in column C is given by:

    Set r = Range("C1").End(xlDown).Offset(1)

but you need to take care in the case that C2:Clastrow are not populated then r will end up as the bottom row of the sheet!  Safest test is:

'if col C has a header row use:    If Range("C2").Value = "" Then

        Set r = Range("C2")

    Else

        Set r = Range("C1").End(xlDown).Offset(1)

    End If

'if col C does not have a header row use:    If Range("C1").Value = "" Then

        Set r = Range("C1")

    ElseIf Range("C2").Value = "" Then

        Set r = Range("C2")

    Else

        Set r = Range("C1").End(xlDown).Offset(1)

    End If

Alternatively, you can use special cells (I believe these are reliable in Excel 2010):

    Set r = Columns("C:C").SpecialCells(xlCellTypeBlanks).Cells(1)

but that will only return truely blank cells, i.e. not any cell containing a formula that has returned "".

Cheers

Rich

Answer 2

Instead of

Set R = Range("C" & Rows.Count).End(xlUp).Offset(1)

you can use

    For Each R In Range("C:C")

        If R.Value = "" Then Exit For

    Next R

Answer 3

Hey Hans, just wanted to notify you that I will be using your method instead as riches method had to many issues while yours works perfectly (as always).

So I just wanted to say thank you!

Answer 4

Hey Hans, sorry I couldn't figure it out. So I used Rich's method and it worked. But thank you for the time you took to look at my question.

I really appreciate your concern.

Answer 5

worked great! appreciate the help