Issue with Vba Loop

[mdo8105]

For some reason my loop is creating duplicate outputs. If anyone can help understand why, I would be grateful

Sub IPutil()

Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Dim frow, lrow, fcol, lcol As Integer
Dim rng, MyCell As Range


Dim sh1, sh2, sh3 As Worksheet


Set sh1 = ThisWorkbook.Worksheets("Internal_Providers")


Set sh2 = ThisWorkbook.Worksheets("INTERNAL_PROV_EXPORT")


Set sh3 = ThisWorkbook.Worksheets("SER_TEMPLATE")


''''Gets StartCell Column and Row
fcol = sh1.Cells(1, Columns.Count).End(xlToLeft).Column
frow = sh1.Cells(Rows.Count, 25).End(xlUp).Row




''''''Gets last row on Ser template Sheet
'sh3.Activate






''''Gets StartCell




Set StartCell = sh1.Cells(frow + 1, fcol)




'Find Last Row and Column
  LastRow = sh1.Cells(sh1.Rows.Count, StartCell.Column).End(xlUp).Row
  LastColumn = sh1.Range("A" & frow).End(xlToRight).Column




'Select Range
  Set rng = sh1.Range(StartCell, sh1.Cells(LastRow, LastColumn))
    For Each MyCell In rng
    If MyCell <> "" Then
        ddd = ThisWorkbook.Worksheets("SER_TEMPLATE").Cells(Rows.Count, 3).End(xlUp).Row
        v1 = MyCell.Row
        '''''Finds Template based on row
        Dim Fvalue As String
        Dim rngToSearch, rngCurrent As Range


        Fvalue = sh1.Cells(v1, 2).Value
        Set wks = Sheets("SER_TEMPLATE")
        Set rngToSearch = wks.Range("C6", "C" & ddd)
        Set rngCurrent = rngToSearch.Find(Fvalue)
        
            ''''''If it does not find a match add base template
            If rngCurrent Is Nothing Then
            dcb = sh2.Cells(Rows.Count, 2).End(xlUp).Row
                sh2.Rows(dcb + 1).EntireRow.Value = sh3.Rows(ddd).EntireRow.Value
                ''''' Adds * for ID
                sh2.Cells(dcb + 1, 1).Value = "*"
                '''''' Adds Role after template has ran
                sh2.Cells(dcb + 1, 3).Value = sh1.Cells(v1, 2).Value
                
            '''''Generate a unique Id
            Call IDGenerator
            '''''If it finds a match
            Else
            dcb = sh2.Cells(Rows.Count, 2).End(xlUp).Row
                v2 = rngCurrent.Row
                sh2.Rows(dcb + 1).EntireRow.Value = sh3.Rows(v2).EntireRow.Value
                '''''Adds * for ID
                sh2.Cells(dcb + 1, 1).Value = "*"
                Call IDGenerator
            End If
                
        
            sh2.Cells(dcb + 1, 2).Value = sh1.Cells(v1, 1).Value
        Else
    End If
    ''Call dlte
    Next MyCell
    '''''Remove Duplicates
















End Sub

 

[My Aswer Is This]

Would you care to tell us what your wanting to do.
There is a lot of code here to try to read through and several call functions.

 

[mdo8105]

Thank you so much for the response. I have 3 sheets I am working with. "sh1" is the input sheet where The columns are static however, the rows are dynamic. I have a cell far off to the right that has a value to mark the header that way I can always find the starting place. Column A will always have a value in it on "sh1". "sh2" is my output sheet and "sh3" is a sheet I have templates on what I am copying. My objective is to have the code loop down my rows until blank. The starting point will be 1 below my header row and on the first row that has a value I want it to look in Column B on the same row on "sh1" and see if it can find a 1:1 match somewhere on "sh3" in Column C. If it finds a match, I want to copy the entire row and paste it on "sh2" in the first blank row below the header. If it does not find a match then I want it to copy the last row with data on "sh3" and paste paste it on "sh2" in the first blank row below the header. The last row with data on "sh3" in Column A will always have data to reference. After the copy takes place I am taking the values that were entered in on "sh1" and mapping to the appropriate columns on "sh2". I hope that helps, I'm a little bit of a novice with VB, so I know my code is a hot mess. The Call is calling a macro that generates a unique ID off to the side on "sh2"

Here is the macro that is being called:

Sub IDGenerator()Dim Low As Long
    Dim High As Long
    Dim r As Long
    Dim sh3 As Worksheet
Set sh3 = ThisWorkbook.Worksheets("INTERNAL_PROV_EXPORT")
    Low = 100000
    High = 999999


r = Int((High - Low + 1) * Rnd() + Low)
dcc = sh3.Cells(Rows.Count, 2).End(xlUp).Row
sh3.Cells(dcc + 1, 100).Value = r
   
















End Sub

Thank you again for your help.

 

[My Aswer Is This]

This is beyond my knowledgebase.
I will continue to monitor this thread to see what I can learn.