Loop through cells until blank

[mdo8105]

I am trying to create a utility that will execute my code until the first blank cell in Column 1. The rows are dynamic and I have a marker cell that will move with the Header Column. I have concept code right now to test that it will actually work and when I run the code nothing is happening not even an error. When I step into the code it is stating all my declared variables are Empty:

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 dcc As Integer


''''Gets StartCell Column
fcol = ThisWorkbook.Worksheets("Internal_Providers").Cells(1, Columns.Count).End(xlToLeft).Column
frow = ThisWorkbook.Worksheets("Internal_Providers").Cells(Rows.Count, 25).End(xlUp).Row


'''''Gets first blank cell on Internal Prov Export Sheet
dcb = ThisWorkbook.Worksheets("INTERNAL_PROV_EXPORT").Cells(Rows.Count, 2).End(xlUp).Row


''''Gets StartCell Row


Set StartCell = ThisWorkbook.Worksheets("Internal_Providers").Cells(frow + 1, fcol)


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


'Select Range
  Set rng = ThisWorkbook.Worksheets("Internal_Providers").Range(StartCell, ThisWorkbook.Worksheets("Internal_Providers").Cells(LastRow, LastColumn))
    For Each MyCell In rng
        If MyCell <> "" Then
        v1 = MyCell.Row
            ThisWorkbook.Worksheets("INTERNAL_PROV_EXPORT").Cells(dcb + 1, 2).Value = ThisWorkbook.Worksheets("Internal_Providers").Cells(v1, 2).Value
        End If
    Next MyCell
   








End Sub

I would love if someone can see why the code is not doing anything.

Thank you

 

[mdo8105]

Okay I figured it out and updated my code, my genius self was referencing a blank cell which is why nothing was pulling over. Now I'm running into a separate issue. I have a Export sheet where I'm wanting my final data to go ("INTERNAL_PROV_EXPORT"). I have another sheet where my templates live ("SER_TEMPLATE") If I find a match from my input sheet ("Internal_Providers") on my template sheet I want it to copy the row and move it to my export sheet in the first blank cell, which this works; however for some reason I am duplicating the process.

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
ddd = ThisWorkbook.Worksheets("SER_TEMPLATE").Cells(Rows.Count, 3).End(xlUp).Row




''''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
        dcb = sh2.Cells(Rows.Count, 2).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
                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
            '''''If it finds a match
            Else
                v2 = rngCurrent.Row
                sh2.Rows(dcb + 1).EntireRow.Value = sh3.Rows(v2).EntireRow.Value
                '''''Adds * for ID
                sh2.Cells(dcb + 1, 1).Value = "*"
            End If
                
        
            sh2.Cells(dcb + 1, 2).Value = sh1.Cells(v1, 1).Value
        End If
    Next MyCell
   












End Sub