Looping code through run

zotee98 · May 11th 2006

I need help looping the following code to run until there is no data in column 3. right now the code only travels through row 193.

Code

Sub dist()


    Range("C4:D4").Select
    Selection.Copy
    Sheets("Inverse Solution").Select
    Range("C3").Select
    ActiveSheet.Paste
    Sheets("Point File").Select
    Range("E4:F4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Inverse Solution").Select
    Range("C4").Select
    ActiveSheet.Paste




    For Row_counter = 7 To 194
        Col_counter = 3
        Sheets("Point File").Select
        Set curCellinPoint = Worksheets("Point File").Cells(Row_counter, Col_counter)
        curCellinPoint.Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Inverse Solution").Select
        Range("G3").Select
        ActiveSheet.Paste
        
        Col_counter = Col_counter + 1
        Sheets("Point File").Select
        Set curCellinPoint = Worksheets("Point File").Cells(Row_counter, Col_counter)
        curCellinPoint.Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Inverse Solution").Select
        Range("H3").Select
        ActiveSheet.Paste
        
        Col_counter = Col_counter + 1
        Sheets("Point File").Select
        Set curCellinPoint = Worksheets("Point File").Cells(Row_counter, Col_counter)
        curCellinPoint.Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Inverse Solution").Select
        Range("G4").Select
        ActiveSheet.Paste
          
        Col_counter = Col_counter + 1
        Sheets("Point File").Select
        Set curCellinPoint = Worksheets("Point File").Cells(Row_counter, Col_counter)
        curCellinPoint.Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Inverse Solution").Select
        Range("H4").Select
        ActiveSheet.Paste
      
        Sheets("Inverse Solution").Select
        Range("C5").Select
        Application.CutCopyMode = False
        Selection.Copy
        Col_counter = Col_counter + 1
        Sheets("Point File").Select
        Set curCellinPoint = Worksheets("Point File").Cells(Row_counter, Col_counter)
        curCellinPoint.Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Next Row_counter
    
End Sub

Display More

Anonymous · May 11th 2006

Re: Looping code through run

You could mod your code as follows to loop automatically through the last used row in column C. (I think you asked this question.)

I don't see why your code is stopping at row 193. Looks like it should do row-counter = 194 also.

Code

Dim LstRow As Long
LstRow = Cells(Rows.Count, 3).End(xlUp).Row
For Row_counter = 7 To LstRow

**Andy Pope** · May 11th 2006

Re: Looping code through run

Hi, this is untested but as well as thomach's suggestion for finding the last row of data in column 3 I think you can reduce your code by not selecting the sheet and ranges.
[vba]
Sub dist()
Dim shtInvSol As Worksheet
Set shtInvSol = Sheets("Inverse Solution")
With Sheets("Point File")
.Range("C4:D4").Copy shtInvSol.Range("C3")
.Range("E4:F4").Copy shtInvSol.Range("C4")

For Row_counter = 7 To .Cells(.Rows.Count, 3).End(xlUp).Row
Col_counter = 3
.Cells(Row_counter, Col_counter).Copy shtInvSol.Range("G3")

Col_counter = Col_counter + 1
.Cells(Row_counter, Col_counter).Copy shtInvSol.Range("H3")

Col_counter = Col_counter + 1
.Cells(Row_counter, Col_counter).Copy shtInvSol.Range("G4")

Col_counter = Col_counter + 1
.Cells(Row_counter, Col_counter).Copy shtInvSol.Range("H4")

shtInvSol.Range("C5").Copy
Col_counter = Col_counter + 1
.Cells(Row_counter, Col_counter).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next Row_counter
End With
End Sub
[/vba]

zotee98 · May 11th 2006

Re: Looping code through run

Works awesome thanks for the help guys! This is the best excel help site on the net -

Looping code through run

Participate now!

Share