VBA Help. Code to replace copy and pasting.

[jaangel90]

Hello,

I have an excel file that is uses a VBA goal seek for each input line. I have a code that currently works (most of the time, errors can pop up when I delete input numbers from cells). As you can see in the code below, for each row of input/output i am having to copy and paste the goal seek function then replace the cell blocks with the current. I am wanting to somehow make it to where I can have basically an infinite amount of rows of inputs/outputs without having to copy and paste over and over.

Sub Macro1()

Dim wb As Workbook


Dim wsC As Worksheet




Set wb = ActiveWorkbook
Set wsC = Worksheets("Mannings Data")
Set wsA = Worksheets("Air Velocity Calculation")


Application.ScreenUpdating = False


wsC.Select


       Static isWorking As Boolean


       If Round(Range("I4").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B4").Value = 0.001
            Range("I4").GoalSeek Goal:=0, ChangingCell:=Range("B4")
            isWorking = False
    
        End If
        
        If Round(Range("I5").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B5").Value = 0.001
            Range("I5").GoalSeek Goal:=0, ChangingCell:=Range("B5")
            isWorking = False
    
        End If
        
        If Round(Range("I6").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B6").Value = 0.001
            Range("I6").GoalSeek Goal:=0, ChangingCell:=Range("B6")
            isWorking = False
    
        End If
        
         If Round(Range("I7").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B7").Value = 0.001
            Range("I7").GoalSeek Goal:=0, ChangingCell:=Range("B7")
            isWorking = False
    
        End If
        
         If Round(Range("I8").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B8").Value = 0.001
            Range("I8").GoalSeek Goal:=0, ChangingCell:=Range("B8")
            isWorking = False
    
        End If
        
         If Round(Range("I9").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B9").Value = 0.001
            Range("I9").GoalSeek Goal:=0, ChangingCell:=Range("B9")
            isWorking = False
    
        End If
        
         If Round(Range("I10").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B10").Value = 0.001
            Range("I10").GoalSeek Goal:=0, ChangingCell:=Range("B10")
            isWorking = False
    
        End If
        
         If Round(Range("I11").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B11").Value = 0.001
            Range("I11").GoalSeek Goal:=0, ChangingCell:=Range("B11")
            isWorking = False
    
        End If
        
         
         If Round(Range("I12").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B12").Value = 0.001
            Range("I12").GoalSeek Goal:=0, ChangingCell:=Range("B12")
            isWorking = False
    
        End If
        
         If Round(Range("I13").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B13").Value = 0.001
            Range("I13").GoalSeek Goal:=0, ChangingCell:=Range("B13")
            isWorking = False
    
        End If
        
         If Round(Range("I14").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B14").Value = 0.001
            Range("I14").GoalSeek Goal:=0, ChangingCell:=Range("B14")
            isWorking = False
    
        End If
        
         If Round(Range("I15").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B15").Value = 0.001
            Range("I15").GoalSeek Goal:=0, ChangingCell:=Range("B15")
            isWorking = False
    
        End If
        
         If Round(Range("I16").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B16").Value = 0.001
            Range("I16").GoalSeek Goal:=0, ChangingCell:=Range("B16")
            isWorking = False
    
        End If
        
         If Round(Range("I17").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B17").Value = 0.001
            Range("I17").GoalSeek Goal:=0, ChangingCell:=Range("B17")
            isWorking = False
    
        End If
        
        If Round(Range("I18").Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Range("B18").Value = 0.001
            Range("I18").GoalSeek Goal:=0, ChangingCell:=Range("B18")
            isWorking = False
    
        End If
Application.ScreenUpdating = False


wsA.Select


End Sub

Thanks!

 

[mrshl9898]

Is this what you are after?

Starts in row 4 and stops when it gets to a "" in column I

Dim wsC As Worksheet



Set wb = ActiveWorkbook
Set wsC = Worksheets("Mannings Data")
Set wsA = Worksheets("Air Velocity Calculation")


Application.ScreenUpdating = False


wsC.Select


    Static isWorking As Boolean
    rownum = 4
        
    Do Until Cells(rownum, 9).Value = ""
       If Round(Cells(rownum, 9).Value, 4) <> 0 And Not isWorking Then
            isWorking = True
            Cells(rownum, 2).Value = 0.001
            Cells(rownum, 9).GoalSeek Goal:=0, ChangingCell:=Cells(rownum, 2)
            isWorking = False
        End If
    rownum = rownum + 1
    Loop
        
Application.ScreenUpdating = False




wsA.Select




End Sub

 

[jaangel90]

Yes, that is awesome. Thanks!