Announcement

Collapse
No announcement yet.

Loop Through Rows Until Blank and Call Macro

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Loop Through Rows Until Blank and Call Macro



    Hi - I wonder if I can explain my problem?

    I have a spreadsheet with a list of names from cell A5 to A? - can be as many as 130 names or as few as 20.

    I have to create individual spreadsheets with the persons name as part of the filename. I have 3 subroutines which work manually ( CreateFile, LookUp and NewWorkbookSave ) so that I can generate individual files for those users who require them.
    However I need to be able on occasions to create a full teams worth of files with one click - to this end I need to be able to loop through cells A5 - A whatever and call the Subroutine CreateFile - I enclose the code I have so far - can anyone help please?

    Cheers
    George

    Code:
    Const Fname = "AON Ver 3,0.xls" 'insert filename here like "AON Ver 3,0.xls"
    Const DirName = "\\Ukplscs105\central repository\AOM\Tally Sheets\Team upload Tally sheets\"
    Const TeamName = "AON\" ' insert team Name here like "AON\"
    Const FilePath = DirName & TeamName
    Dim count As Integer
    
    
    
    Sub CreateFile()
    
        ChDir FilePath
        Workbooks.Open Filename:=FilePath & Fname
        
        Range("C3").Select
        ActiveWindow.WindowState = xlMinimized
    Call LookUp
       
        Selection.Copy
        Windows(Fname).Activate
        ActiveWindow.WindowState = xlNormal
        ActiveWindow.WindowState = xlNormal
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
      Call NewWorkbooksave
    End Sub
    Sub LookUp()
        Dim rRange As Range
        Dim vResult
        Set rRange = ActiveCell
    End Sub
      
    Sub NewWorkbooksave()
        ChDir FilePath
        ActiveWorkbook.SaveAs Filename:=Range("C3") & Fname, FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
         ActiveWorkbook.Close True
         
    End Sub
    
    Sub CreateTeam()
    count = 5
    Range("A" & count).Select
    While ActiveCell <> ""
        Call CreateFile
        
        count = count + 1
           
        ActiveCell = Range("A" & count).Select
    Wend
    
    End Sub

  • #2
    Re: Loop Through Rows Until Blank and Call Macro

    Here's a simple loop macro for you:
    Code:
    Option Explicit
    
    Sub MyMacro()
    Dim MyCell, Rng As Range
    Set Rng = Sheets("Sheet1").Range("A5:A200")'''''sets the range to use
    For Each MyCell In Rng''''checks each cell in range
    If MyCell <> "" Then'''''will only do something if the cell is not blank
    MsgBox "Replace This Line With The Call To CreateYour File"'''Put your code here
    Else'''''if cell is equal to blank
    Exit Sub''''then quit macro
    End If
    Next
    End Sub
    Regards,
    Simon
    Regards,
    Simon

    In the unlikely event you don't get an answer here try Microsoft Office Help for FREE!
    Please take the time to read these rules before posting!

    Comment


    • #3
      Re: Loop Through Rows Until Blank and Call Macro

      Your Lookup macro appears to serve no purpose. It sets a variable to equal the active cell and then does nothing. As the variable is declared within the Macro it is not used by any other macro.

      Try this macro for looping through the range of used cells a5 to last used row in column A

      Code:
      Sub CreateMultipleFiles()
         Dim iLastRow As Integer
         Dim Rng As Range
         iLastRow = Cells(Rows.Count, "a").End(xlUp).Row
         For Each Rng In Range("a5:a" & iLastRow)
            If Not Rng.Value = vbNullString Then
               Rng.Select
               Call CreateFile
            End If
         Next Rng
      End Sub
      Last edited by mudraker; February 16th, 2007, 21:16.

      Comment


      • #4
        Re: Loop Through Rows Until Blank and Call Macro

        Thanks for the response guys
        Simon - yours works but I don't know why - which is all down to my ignorance and not your coding!

        that is why i have decided to go along with Mudrakers solution. ( BTW you were right about the Lookup macro - it was a legacy from something else I was testing )

        Once again thank you - what would I do without this forum?

        George

        Comment


        • #5
          Re: Loop Through Rows Until Blank and Call Macro

          Thanks for the feed back

          Simons code is basically the same as mine - just structured slightly different

          My code checks a5 to last used row in column A
          Simons checks a5 to a200

          Both these codes are designed to loop through a range of cells - the setting of the range cells is slightly different. Simon set his befor the For command & I set mine as part of the For command - see to parts highlighted in red

          Code:
          Simons code
          
          Set Rng = Sheets("Sheet1").Range("A5:A200") 
          For Each MyCell In Rng
          
          My code
          iLastRow = Cells(Rows.Count, "a").End(xlUp).Row
          For Each Rng In Range("a5:a" & iLastRow)
          Both of these commands check if the cell is blank

          Code:
          If Not Rng.Value = vbNullString Then
          If MyCell <> "" Then

          Comment


          • #6


            Re: Loop Through Rows Until Blank and Call Macro

            Mudraker is being modest he has made his range Dynamic which i was too lazy to do
            Code:
            iLastRow = Cells(Rows.Count, "a").End(xlUp).Row 
                For Each Rng In Range("a5:a" & iLastRow)
            effectively this couple of lines ensures that the code will run no matter what size of list you have in column A, whereas mine will not include any items below row 200!

            Regards,
            Simon
            Regards,
            Simon

            In the unlikely event you don't get an answer here try Microsoft Office Help for FREE!
            Please take the time to read these rules before posting!

            Comment

            Working...
            X