loop row until cell empty

[anisha.silva]

hi,

I have an excel sheet and the is a row filled with data the row starts from B5 everytime, what i want to do it to read the values of the cell until the row comes to an empty cell
how do i do it,
thanks

appreciate a reply,
thanks

[tinstaafl]

try this:

Public Sub Main()
    Dim Values As Range
    Dim CurrentSheet As Worksheet
    Set CurrentSheet = ActiveWorkbook.ActiveSheet
    Set Values = Rows(5)
    For i = 2 To Values.Cells.Count - 1
        If Values.Cells(i).Text <> "" Then
            'here you can do what you want with each cell using the Values.Cells(i).Text property
            MsgBox (Values.Cells(i).Text)
        End If

    Next

End Sub

Put this in a module. and run it as a macro named Main.

[AndreRet]

As usual, tinstaafl is spot on. Here are a few more samples...

To Search a List with a Constant, Known Number of Rows

This code moves down column A to the end of the list:

Sub Test1()
      Dim x As Integer
      ' Set numrows = number of rows of data.
      NumRows = Range("B5", Range("B5").End(xldown)).Rows.Count
      ' Select cell a1.
      Range("B5").Select
      ' Establish "For" loop to loop "numrows" number of times.
      For x = 1 To NumRows
         ' Insert your code here.
         ' Selects cell down 1 row from active cell.
         ActiveCell.Offset(1, 0).Select
      Next
   End Sub

To Search a Dynamic List or a List with an Unknown Number of Rows

This code moves down column A to the end of the list. (This code assumes that each cell in column A contains an entry until the end.)

Sub Test2()
      ' Select cell B5, *first line of data*.
      Range("B5").Select
      ' Set Do loop to stop when an empty cell is reached.
      Do Until IsEmpty(ActiveCell)
         ' Insert your code here.
         ' Step down 1 row from present location.
         ActiveCell.Offset(1, 0).Select
      Loop
   End Sub

Note If there are empty cells in column A throughout the data, modify this code to account for this condition. Make sure that the empty cells are a consistent distance apart. For example, if every other cell in column A is empty (for example, this situation may occur if every 'record' uses two rows, with the second row indented one cell), this loop can be modified as follows:

' Set Do loop to stop when two consecutive empty cells are reached.
      Do Until IsEmpty(ActiveCell) and IsEmpty(ActiveCell.Offset(1, 0))
         ' Insert your code here.
         '
         ' Step down 2 rows from present location.
         ActiveCell.Offset(2, 0).Select
      Loop

And lastly...

To Search a List for a Specific Record

This code moves down column A to the end of the list:

Sub Test3()
      Dim x As String
      Dim found As Boolean
      ' Select first line of data.
      Range("B5").Select
      ' Set search variable value.
      x = "test"
      ' Set Boolean variable "found" to false.
      found = False
      ' Set Do loop to stop at empty cell.
      Do Until IsEmpty(ActiveCell)
         ' Check active cell for search value.
         If ActiveCell.Value = x Then
            found = TRUE
            Exit Do
         End If
         ' Step down 1 row from present location.
         ActiveCell.Offset(1, 0).Select
      Loop
   ' Check for found.
      If found = True Then
         Msgbox "Value found in cell " & ActiveCell.Address
      Else
         Msgbox "Value not found"
      End If
   End Sub

[ranilxmie]

hi.. I want to create a similar loop, but what is need is to copy a range of data (example from A1:A10) for about 5 times.
meaning, 1st copy, A1:A10 in B1:10, then copy A1:A10 again in B11:B20 and so on for 5 times.. any expert advise pls ?

[tinstaafl]

You should post this as a new question, instead of adding on to an old question. If necessary you can refer to the old one in your question.

[bormand]

Hello,
For about 2 weeks I am struggling to get/do/find the code that helps me find the first empty cell in a row.
This is my first programming experinece, have never program before.

I do understand the logic of this code, but when I try to use "
IsEmpty(ActiveCell)" in Micorsoft Visual Studio, I keep receiveing "IsEmpty" is not declared and "ActiveCell" is not declared.

Do you have any idea what I am doing wrong here?

Thanks for your support

[tinstaafl]

You should post this as a new question, instead of adding on to an old question. If necessary you can refer to the old one in your question.

[bormand]

I thought this place is about helping people :)
thanks for the support ;)

[tinstaafl]

Asking for help is also about following the Rules. This not only gets you the help you need but also enables others to benefit from the help you receive.

[Ashley1990_vba]

Sub Contator()

Dim i As Integer ' contador de posição
Dim p As Integer ' valor deu um numero positivo
Dim pp As Integer ' contador do p
Dim n As Integer ' valor deu um numero negativo
Dim nn As Integer ' contador do n
Dim t As Integer ' variavel de confere
Dim x As Integer ' variavel para ser conferida

i = 1

Set Worksheets("Plan 1").Range("A1") = x
Set Worksheets("Plan 2").Cells(1, i).Value = t

Do Until IsEmpty(t)

If x > t Then

p = pp + 1

Else

n = nn + 1

End If

i = i + 1
Loop
End Sub

[Ashley1990_vba]

I am begginer of vba tools, could you help me guys?

[Phoguez]

Sub FindEmptyCell()
    'this will run on column A in Excel
    'not in vb.net. 
    'add some text to each row on the first column
    'Hit ctrl-break to stop if ever column A 
    'is empty.


    Dim i As Integer
    i = 1

    Range("A1").Select

    Do Until False
        i = i + 1

        Range("A" & i).Select

        If ActiveSheet.Cells(i, 1) = "" Then
            MsgBox "Found the empty cell"
            Exit Do
        End If

    Loop

End Sub

[sathish scrop]

I have created an VB code which flech data from excel cells to ms word and save it as PDF.
But when the macro try to take the empty cells in excel it throws a run time erroe 4198.
Can some body help me on this.

Private Sub Button2_Click()
Dim StrFileName As String

Dim iloop As Long

'Dim afso As New FileSystemObject, arange As Range

Dim arrange As Range

Dim aWApp As Word.Application, aWDoc As Word.Document

Dim SigString As String

Dim objOutlook As New Outlook.Application

Dim objOutlookMsg As Outlook.MailItem

 Dim i As Long

     Range("A1").Select
     Range(Selection, Selection.End(xlDown)).Select
     flecnt = Selection.Count

For i = 3 To flecnt

    Set aWApp = New Word.Application
    aWApp.Visible = True
    aWApp.DisplayAlerts = wdAlertsNone
    aWApp.Visible = True     

    temppth = "f:\ttt.docx"

                      Set aWDoc = aWApp.Documents.Open(temppth)
                       WL = "f:\"
            wlpth = WL & "W.docx"

    Set myRange = aWDoc.Content
    tfindtext = "LLFL"
    'ordersplit = Sheets("1").Cells(i, 3)
    treplacetext = Sheets(1).Cells(i, 1)
    myRange.Find.Execute FindText:=tfindtext, ReplaceWith:=treplacetext, Replace:=wdReplaceAll

    Set myRange1 = aWDoc.Content
    tfindtext = "ZDEL"
    'ordersplit = Sheet5.Cells(1, 3)
   treplacetext = Sheets(1).Cells(i, 2)
    myRange.Find.Execute FindText:=tfindtext, ReplaceWith:=treplacetext, Replace:=wdReplaceAll

    Set myRange2 = aWDoc.Content
    tfindtext = "AM ORDER"
    'ordersplit = Sheet5.Cells(i, 6)
     treplacetext = Sheets(1).Cells(i, 6)
    myRange.Find.Execute FindText:=tfindtext, ReplaceWith:=treplacetext, Replace:=wdReplaceAll

    Set myRange3 = aWDoc.Content
    tfindtext = "ST DATE"
    'ordersplit = Sheet5.Cells(i, 5)
     treplacetext = Sheets(1).Cells(i, 4)
    myRange.Find.Execute FindText:=tfindtext, ReplaceWith:=treplacetext, Replace:=wdReplaceAll

    Set myRange4 = aWDoc.Content
    tfindtext = "ED DATE"
    'ordersplit = Sheet5.Cells(i, 2)
     treplacetext = Sheets(1).Cells(i, 5)
    myRange.Find.Execute FindText:=tfindtext, ReplaceWith:=treplacetext, Replace:=wdReplaceAll

    Set myRange5 = aWDoc.Content
    tfindtext = "#SAID#"
    'ordersplit = Sheet5.Cells(i, 6)
     treplacetext = Sheets(1).Cells(i, 3)
    myRange.Find.Execute FindText:=tfindtext, ReplaceWith:=treplacetext, Replace:=wdReplaceAll

     Set myRange6 = aWDoc.Content
     tfindtext = "Sm Name"
    'ordersplit = Sheet5.Cells(i, 7)
     treplacetext = Sheets(1).Cells(i, 8)
     myRange.Find.Execute FindText:=tfindtext, ReplaceWith:=treplacetext, Replace:=wdReplaceAll

    Set myRange7 = aWDoc.Content
     tfindtext = "SH Company"
    'ordersplit = Sheet5.Cells(i, 7)
     treplacetext = Sheets(1).Cells(i, 9)
     myRange.Find.Execute FindText:=tfindtext, ReplaceWith:=treplacetext, Replace:=wdReplaceAll

     Set myRange8 = aWDoc.Content
     tfindtext = "Address Line"
    'ordersplit = Sheet5.Cells(i, 7)
     treplacetext = Sheets(1).Cells(i, 10)
     myRange.Find.Execute FindText:=tfindtext, ReplaceWith:=treplacetext, Replace:=wdReplaceAll

     Set myRange9 = aWDoc.Content
     tfindtext = "City"
    'ordersplit = Sheet5.Cells(i, 7)
     treplacetext = Sheets(1).Cells(i, 11)
     myRange.Find.Execute FindText:=tfindtext, ReplaceWith:=treplacetext, Replace:=wdReplaceAll

     Set myRange10 = aWDoc.Content
     tfindtext = "Postal"
    'ordersplit = Sheet5.Cells(i, 7)
     treplacetext = Sheets(1).Cells(i, 12)
     myRange.Find.Execute FindText:=tfindtext, ReplaceWith:=treplacetext, Replace:=wdReplaceAll

     Set myRange12 = aWDoc.Content
     tfindtext = "Countryz"
    'ordersplit = Sheet5.Cells(i, 7)
     treplacetext = Sheets(1).Cells(i, 14)
     myRange.Find.Execute FindText:=tfindtext, ReplaceWith:=treplacetext, Replace:=wdReplaceAll

   ' Set myRange10 = aWDoc.Content
   ' tfindtext = "UUUUUUUUUUUU"
    'ordersplit = Sheet5.Cells(i, 12)
   ' treplacetext = Replace(ordersplit, Chr(10), Chr(13))
    'myRange10.Find.Execute FindText:=tfindtext, ReplaceWith:=treplacetext, Replace:=wdReplaceAll
    'myRange10.Find.Execute FindText:=tfindtext, ReplaceWith:=treplacetext, Replace:=wdReplaceAll

    aWDoc.SaveAs2 "C:\USWL\" & Sheets(1).Cells(i, 2) & ".pdf", 17

    aWDoc.Close False
    aWApp.Quit False
    Set objOutlookMsg = Nothing

    Next i

End Sub

[tinstaafl]

You should post this as a new question, instead of adding on to an old question. If necessary you can refer to the old one in your question.