for to alternative/variable for to maximum counter?

Question

I've written a macro which copys the strings of three cells left to a marked cell and pastes those to the next free line in a specific worksheet:

Sub testmacro_01()
    'setting the variables
    Dim x As Integer
    Dim y As Integer
    Dim string1 As String
    Dim string2 As String
    Dim string3 As String
    'setting start values
    x = 1
    y = 1
    string1 = ""
    string2 = ""
    string3 = ""
    'checking for "m" in the "checkcolumn", if "m" then copy columns left to it:
    For x = 1 To 100
        If ThisWorkbook.Sheets("testsheet").Cells(x, 4).Value = "m" _
        Then
            string1 = ThisWorkbook.Sheets("testsheet").Cells(x, 1).Value
            string2 = ThisWorkbook.Sheets("testsheet").Cells(x, 2).Value
            string3 = ThisWorkbook.Sheets("testsheet").Cells(x, 3).Value
            'checking for the next free line in "newsheet":
Line1:
            If ThisWorkbook.Sheets("newsheet").Cells(y, 1).Value = "" _
                    And ThisWorkbook.Sheets("newsheet").Cells(y, 2).Value = "" _
                    And ThisWorkbook.Sheets("newsheet").Cells(y, 1).Value = "" _
                Then
                'pasting the strings into the free lines:
                ThisWorkbook.Sheets("newsheet").Cells(y, 1).Value = string1
                ThisWorkbook.Sheets("newsheet").Cells(y, 2).Value = string2
                ThisWorkbook.Sheets("newsheet").Cells(y, 3).Value = string3
            Else
                'if the checked line is full the search will go down by 1 line:
                y = y + 1
                GoTo Line1
            End If
        End If
    Next
End Sub

For example: This is the source sheet

(every line left to a line marked with the letter "m" in column D should be copied)

and this is the result after playing the macro.

(cells with grey background are there to test the "next free line function")

That's where I'm stuck: While this macro works and does what it should do, I feel like it is quite static and can be done more "professionally". My focus here is on the "for to" loop: How do I put a variable number which will always include all the existing lines in the textsheet into the for to loop instead of the "100"? Changing 100 to 1000 will work for most of my applications, but seems very prude.

A great answer [here](http://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba) on how to find the last cell in a column. Store that in the variable and use that as your loop upper limit — gtwebb, May 19 '16 at 19:45

Scott Craner · Answer 1 · 2016-05-19T20:06:20.567

This addresses most of your problems:

Sub foo2()
Dim ows As Worksheet
Dim tws As Worksheet
Dim rng As Range
Dim lastrow As Long
Dim twslastrow As Long
Dim letr As String

Set ows = Sheets("testsheet")
Set tws = Sheets("newsheet")

letr = "m" ' change this to reference what you want.
twslastrow = tws.Cells.Find("*", tws.Range("A1"), , xlPart, xlByRows, xlPrevious, False).Row
With ows
    lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    For Each rng In .Range(.Cells(2, 4), .Cells(lastrow, 4))
        If rng.Value = letr Then
            Dim insertrow
            insertrow = tws.Evaluate("=MATCH(1,INDEX(($A$1:$A$" & twslastrow & "="""")*($C$1:$C$" & twslastrow & "="""")*($B$1:$B$" & twslastrow & "=""""),),0)")
            If IsError(insertrow) Then
                insertrow = tws.Cells.Find("*", tws.Range("A1"), , xlPart, xlByRows, xlPrevious, False).Row + 1
            End If

            tws.Range(tws.Cells(insertrow, 1), tws.Cells(insertrow, 3)).Value = .Range(.Cells(rng.Row, 1), .Cells(rng.Row, 3)).Value

        End If
    Next rng
End With
End Sub

score 0 · Answer 2 · answered May 19 '16 at 19:47

There are several methods for looping through a bunch of rows:

'Find the first blank line    
r = 1
Do While Cells(r,1).Value <> "" 
    r = r +1
Loop

Or

LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row

or

LastRowColA = Range("A65536").End(xlUp).Row

or

LastRow = Cells.Find("*",SearchOrder:=xlByRows,SearchDirection:=xlPrevious).Row

or

LastRow = ActiveSheet.UsedRange.Rows.Count

And correcting the GoTo and adding a custom filter

strFilter = InputBox("Enter your copy criteria:")
x = 1 'Start on row 1 and loop until the 1st blank line in Column A
Do While Sheets("testsheet").Cells(x, 1).Value <> "" 
    If Sheets("testsheet").Cells(x, 4).Value = strFilter Then
        With ThisWorkbook.Sheets("testsheet")
            string1 = .Cells(x, 1).Value
            string2 = .Cells(x, 2).Value
            string3 = .Cells(x, 3).Value
        End With

        With ThisWorkbook.Sheets("newsheet")
            y = .UsedRange.Rows.Count + 1 
            'We know this row is blank so skip all the code below
'            If .Cells(y, 1).Value = "" And _
'               .Cells(y, 2).Value = "" And _
'               .Cells(y, 1).Value = "" _
'            Then
            'pasting the strings into the free lines:
            .Cells(y, 1).Value = string1
            .Cells(y, 2).Value = string2
            .Cells(y, 3).Value = string3
        End With

        ' There is no Else because we found our last row
'        Else
'if the checked line is full the search will go down by 1 line:
'        y = y + 1
'        GoTo Line1
'        End If
    End If
    x = x + 1
Loop

for to alternative/variable for to maximum counter?

2 Answers2