VBA Help - Rewrite my Loop in a different order

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
601
Office Version
2016
Platform
MacOS
Hello All,


Need some help with my loop code, currently it works great for the first loop, the issue I am having is that I am using a .Find Method to search a column for a value (Currently working great) problem is that once I Declare the found variable the code process a few updates based on that found value but then in the event there is more than one instance of that found value I need my code to start over again with the next instance of that found value. I have all the pieces of the puzzle working just not in the correct order and I am unable to think of a way to correct this. Any help is appreciated!

Code:
Set ws2 = Sheets("Form")
    LastR3 = ws2.Cells(Rows.Count, "A").End(xlUp).Row


PrjCount = Application.WorksheetFunction.CountIf(FoundSht.Range("C10:C" & LastR2), Project) 'Counts all the occurences of my Value - Will be used to determine how many times to do the loop
Timestamp = Format(CStr(Now), "mm/dd/yyyy hh:mmam/pm")
    
    For i = 1 To PrjCount   'Defines how many times to do the loop of in the event there is more than 1 Project Found
            
           ws2.Range("H1").Value = i 'I have code that makes a copy of the Form Sheet and Timestamps the file and appends the Searched Value as the Filename - In the event of duplicates this will make each file unique
            
            '----------------------Provides Loop to Search for Project in Column C----------------------
            With FoundSht.Range("C10:C" & LastR3)
                Set LastCell = .Cells(.Cells.Count)
            End With
            Set Foundcell = FoundSht.Range("C10:C" & LastR3).Find(what:=Project, after:=LastCell) 'Gets my Search Value for the 1st time
            
            If Not Foundcell Is Nothing Then
                FirstAddr = Foundcell.Address
                End If
                
                Do Until Foundcell Is Nothing
                FoundSht.Range("C" & Foundcell.Row & ":" & LastCL2 & Foundcell.Row).Copy 'Copies my found value and pastes it into a seperate sheet "Form"
                ws2.Range("G5").PasteSpecial xlValues, Transpose:=True
                
            '----------------------Provides Loop to Search for Project in Column C----------------------
                         With ws2
                            .Range("B5:H" & LastR3).ClearContents   'Clears old data before start
                                .Range("C1").Value = Project   'Applies Poject Name in Header
                                    .Range("B2").Value = "Type: " & SrchSht      'Applies Poject Name in Header
                                        .Range("H2").Value = Timestamp  'Applies Time Stamp in header
                            
                            FoundSht.Range("C4:" & LastCL2 & "4").Copy  'Copies Category
                                .Range("B5").PasteSpecial xlValues, Transpose:=True
                        
                            FoundSht.Range("C6:" & LastCL2 & "6").Copy  'Copies Attribute
                                .Range("C5").PasteSpecial xlValues, Transpose:=True
                                
                            FoundSht.Range("C7:" & LastCL2 & "7").Copy  'Copies Field Type
                                .Range("D5").PasteSpecial xlValues, Transpose:=True
                                
                            FoundSht.Range("C8:" & LastCL2 & "8").Copy  'Copies Selection Options
                                .Range("E5").PasteSpecial xlValues, Transpose:=True
                                
                            FoundSht.Range("C9:" & LastCL2 & "9").Copy  'Copies Data Source
                                .Range("F5").PasteSpecial xlValues, Transpose:=True
                         End With
                            
                Call SaveSheet  ' Creates Copy of Sheet and Sets Print Details                
               
                Set Foundcell = FoundSht.Range("C10:C" & LastR3).FindNext(after:=Foundcell)  '<-----------------------------Here is one of the problems, this will continue the search to see if there is another Value within the range - If found, I need it to go back to the Start of the Clear Contents code to run through that whole block again


                If Foundcell.Address = FirstAddr Then
                    Exit Do 'If no other values are found exit this loop
                End If
            Loop
            '----------------------Provides Loop to Search for Project in Column C----------------------
        
    
    Next i 'Continues the overall loop - May be redundant
 
Last edited:

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,607
Office Version
2007
Platform
Windows
Not tested, because it is not all the code and I do not see several variables and sheets.

You only need one loop.


Code:
  Dim i As Long
  i = 1
  Set WS2 = Sheets("Form")
  Timestamp = Format(CStr(Now), "mm/dd/yyyy hh:mmam/pm")
  LastR3 = FoundSht.Cells(Rows.Count, "C").End(xlUp).Row 'column C, Because it is the search column
  Set Foundcell = FoundSht.Range("C10:C" & LastR3).Find(Project, , xlValues, xlWhole)  'Gets my Search Value for the 1st time
  If Not Foundcell Is Nothing Then
    FirstAddr = Foundcell.Address
[COLOR=#0000ff]    Do Until Foundcell Is Nothing[/COLOR]
      WS2.Range("H1").Value = i
      i = i + 1
      FoundSht.Range("C" & Foundcell.Row & ":" & LastCL2 & Foundcell.Row).Copy 'Copies my found value and pastes it into a seperate sheet "Form"
      WS2.Range("G5").PasteSpecial xlValues, Transpose:=True
      WS2.Range("B5:H" & LastR3).ClearContents   'Clears old data before start
      WS2.Range("C1").Value = Project   'Applies Poject Name in Header
      WS2.Range("B2").Value = "Type: " & SrchSht      'Applies Poject Name in Header
      WS2.Range("H2").Value = Timestamp  'Applies Time Stamp in header
      FoundSht.Range("C4:" & LastCL2 & "4").Copy  'Copies Category
      WS2.Range("B5").PasteSpecial xlValues, Transpose:=True
      FoundSht.Range("C6:" & LastCL2 & "6").Copy  'Copies Attribute
      WS2.Range("C5").PasteSpecial xlValues, Transpose:=True
      FoundSht.Range("C7:" & LastCL2 & "7").Copy  'Copies Field Type
      WS2.Range("D5").PasteSpecial xlValues, Transpose:=True
      FoundSht.Range("C8:" & LastCL2 & "8").Copy  'Copies Selection Options
      WS2.Range("E5").PasteSpecial xlValues, Transpose:=True
      FoundSht.Range("C9:" & LastCL2 & "9").Copy  'Copies Data Source
      WS2.Range("F5").PasteSpecial xlValues, Transpose:=True
      
      Call SaveSheet  ' Creates Copy of Sheet and Sets Print Details
      Set Foundcell = FoundSht.Range("C10:C" & LastR3).FindNext(Foundcell)
[COLOR=#0000ff]    Loop While Not Foundcell Is Nothing And Foundcell.Address <> FirstAddr[/COLOR]
  End If
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,607
Office Version
2007
Platform
Windows
I'm glad to help you. Thanks for the feedback.
 

Forum statistics

Threads
1,085,014
Messages
5,381,235
Members
401,722
Latest member
Excellica

Some videos you may like

This Week's Hot Topics

Top