Home > database >  How do I edit my code to make the program automatically select the next row after it is done analysi
How do I edit my code to make the program automatically select the next row after it is done analysi

Time:10-16

I have a table that contains information on my classroom, which includes their names followed by the phone they use (IOS or Android) followed by if they are eligible for a test. Using this information the code places it in the corresponding worksheets (IOS YES) or (ANDROID YES). However, I want my code to move on to the second row after it analyses the first one. How do i do that?

Here is what I have so far:

 While Sheets("BASE").Range("D2").Value <> ""

If Sheets("BASE").Range("D2").Value = "IOS" And Sheets("BASE").Range("E2").Value = "Y" Then
    Sheets("BASE").Range("A2:E2").Select
    Selection.Copy
    Sheets("IOS YES").Select
    Range("A2:E2").Select
    ActiveSheet.Paste
ElseIf Sheets("BASE").Range("D2").Value = "ANDROID" And Sheets("BASE").Range("E2").Value = "Y" Then
    Sheets("BASE").Range("A2:E2").Select
    Selection.Copy
    Sheets("ANDROID YES").Select
    Range("A2:E2").Select
    ActiveSheet.Paste
End If
Wend

CodePudding user response:

You need counters for the rows: for the base-sheet = rBase, ios-sheet = rIOS etc.

You don't need to select/copy/paste - you can simply write the values to the cells. This is much faster.

Furthermore I am assuming that your data on base sheet is in a contious range i.e. no empty rows inbetween - then you can use CurrentRegion to get the number of rows you have to check.

I am applying the worksheets to variables as it makes the code more readable (= "less noise" compared to repeating Thisworkbook.worksheet-stuff ...). And if the worksheet names change - you have to adjust the code only in one place.

Sub copyRows()
Dim wsBase As Worksheet
Set wsBase = ThisWorkbook.Worksheets("BASE")

Dim wsAndroid As Worksheet
Set wsAndroid = ThisWorkbook.Worksheets("ANDROID YES")

Dim wsIOS As Worksheet
Set wsIOS = ThisWorkbook.Worksheets("IOS YES")


Dim cntRows As Long
cntRows = wsBase.Range("A1").CurrentRegion.Rows.Count

Dim rBase As Long, rIOS As Long, rAndroid As Long
rIOS = 1: rAndroid = 1

Dim OS As String

For rBase = 2 To cntRows
    If wsBase.Range("E" & rBase) = "Y" Then
        OS = wsBase.Range("D" & rBase)
        If OS = "IOS" Then
            rIOS = rIOS   1
            wsIOS.Range("A" & rIOS & ":E" & rIOS).Value = wsBase.Range("A" & rBase & ":E" & rBase).Value
        ElseIf OS = "ANDROID" Then
            rAndroid = rAndroid   1
            wsAndroid.Range("A" & rAndroid & ":E" & rIOS).Value = wsBase.Range("A" & rBase & ":E" & rBase).Value
        End If
    End If
Next

End Sub
  • Related