CODEWITHSUNDEEP
excelvbaloops
Aizat Kassim
Aizat Kassim

Reputation: 43

how to do while loop vba

I have codes written (as below) that find the word Total in Column B. It then exports the selection to PDF. The word Total is then replaced by Done.

I am trying to find a way to repeat this code until there is no more Total in Column B. 

Columns("B:B").Select
Selection.Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(-1, -1).Activate

    ActiveSheet.Range(Selection, Selection.End(xlUp)).Select
    Selection.Resize(, 15).Select
    Selection.Offset(, 1).Select


    Dim rng As Range
    With ActiveSheet
    Set rng = Selection
    .PageSetup.PrintArea = rng.Address
    .PageSetup.Orientation = xlLandscape
    .PageSetup.FitToPagesWide = 1
    .PageSetup.FitToPagesTall = 999
    .PageSetup.PrintTitleRows = "$1:$4"
    .PageSetup.LeftMargin = Application.InchesToPoints(0.45)
    .PageSetup.RightMargin = Application.InchesToPoints(0.2)
    .PageSetup.TopMargin = Application.InchesToPoints(0.25)
    .PageSetup.BottomMargin = Application.InchesToPoints(0.25)
    .PageSetup.HeaderMargin = Application.InchesToPoints(0.3)
    .PageSetup.FooterMargin = Application.InchesToPoints(0.3)
    .PageSetup.PaperSize = xlPaperA4
    .PageSetup.CenterHorizontally = True
    .PageSetup.CenterVertically = False


    Selection.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:="C:Users\kgs-aizat.kassim\Desktop\" & ActiveCell.Offset(0, -1).Value & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    End With

Columns("B:B").Select

Selection.Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

    ActiveCell.Value = "Done"

 End Sub

Upvotes: 1

Views: 870

Answers (3)

Tom
Tom

Reputation: 9878

I see you're using the 'find' command you can use 'findnext'

Dim rng As Range
With ActiveSheet
    set c = .Columns("B:B").Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Offset(-1, -1)

    if c is not nothing then
        firstaddress  = c.address
     do
        c.select
    .Range(Selection, Selection.End(xlUp)).Select
    Selection.Resize(, 15).Select
    Selection.Offset(, 1).Select

    Set rng = Selection
    .PageSetup.PrintArea = rng.Address
    .PageSetup.Orientation = xlLandscape
    .PageSetup.FitToPagesWide = 1
    .PageSetup.FitToPagesTall = 999
    .PageSetup.PrintTitleRows = "$1:$4"
    .PageSetup.LeftMargin = Application.InchesToPoints(0.45)
    .PageSetup.RightMargin = Application.InchesToPoints(0.2)
    .PageSetup.TopMargin = Application.InchesToPoints(0.25)
    .PageSetup.BottomMargin = Application.InchesToPoints(0.25)
    .PageSetup.HeaderMargin = Application.InchesToPoints(0.3)
    .PageSetup.FooterMargin = Application.InchesToPoints(0.3)
    .PageSetup.PaperSize = xlPaperA4
    .PageSetup.CenterHorizontally = True
    .PageSetup.CenterVertically = False


    Selection.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:="C:Users\kgs-aizat.kassim\Desktop\" & ActiveCell.Offset(0, -1).Value & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    loop While Not c Is Nothing And c.Address <> firstAddress 
End if 
end with
 End Sub

This will loop through all cells that match your criteria

Upvotes: 0

PaulG
PaulG

Reputation: 1189

Here's some code that will search column B for all entries of SearchItem. You need to include an invocation to your PDF processing within this.

By the way, if you changing the cell contents to 'Done' as a means to see if there are no more cells to process, you don't need to do that. If you comment out the line:

rPtr.Value = ReplaceItem

the code will still find the cells only once.

Option Explicit

Sub test()

Dim rData As Range
Set rData = Sheets(1).Range("B:B")
Call ReplaceContents("Test", "Test1", rData)

End Sub

Public Sub ReplaceContents(ByVal SearchItem As String, ByVal ReplaceItem As String, ByVal DataArea As Range)

Dim rPtr As Range
Dim sFirstCell As String
Dim bFinished As Boolean

Set rPtr = DataArea.Find(SearchItem, DataArea(DataArea.Count), XlFindLookIn.xlValues)
If Not rPtr Is Nothing Then
    sFirstCell = rPtr.Address
    Do While bFinished = False
        rPtr.Value = ReplaceItem
        Set rPtr = DataArea.FindNext(rPtr)
        If StrComp(rPtr.Address, sFirstCell, vbTextCompare) = 0 Then bFinished = True
    Loop
End If

End Sub

Upvotes: 1

Sam
Sam

Reputation: 948

Have a look at http://www.excel-easy.com/vba/loop.html

What you need to do is follow the link above. And then you will to get the total amount of rows used in column "B" and use that as your end to your for loop.

So basically it will be something like

For i = 2 to columnBCount
    do code.......
next

You will just need to replace columnBCount with an actual way to get the count.

I have set i to be 2 As if you have titles this will not include them and start at the second row.

But read up on the loops from the link

Upvotes: 0

Related Questions