VBA Help - Rewrite my Loop in a different order

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
652
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:

Some videos you may like

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,102
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
12,102
Office Version
2007
Platform
Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,101,934
Messages
5,483,774
Members
407,410
Latest member
catherinejoy

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top