Search code examples
vbaworksheetexcel-automation

Trying to loop IF(MID function in worksheet


I have a sheet called Data that I copy and paste data from a fixed width .txt file. It's about 100,000+ rows of data that I need to loop through every row and pull data from and if it matches the criteria it shows the results on a sheet called AVS. I'm sure I'm missing something simple but for the life of me it will only give me the result from the first line only then stop.

Here's what I have so far:

Sub AVSRev()
    Dim ws As Worksheet, thisRng As Range, ws1 As Worksheet
    Dim lastrow As Long

    Set ws1 = ThisWorkbook.Sheets("Data")
    Set ws = ThisWorkbook.Sheets("AVS")
    Set thisRng = ws.Range("A1")

    Application.ScreenUpdating = False

    With ws
        lastrow = .Range("A" & .Rows.Count).End(xlUp).row

        If Mid(ws1.Range("A1:A" & lastrow).Value, 1, 3) = "AVS" Then
        thisRng = Mid(ws1.Range("A1:A" & lastrow).Text, 48, 4)

        End If

        On Error Resume Next
        Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Clear
        Application.ScreenUpdating = True
    End With
End Sub

After a couple days of messing with this I've rewritten the code as below. I do not get any errors as I was before but it takes forever and when finished no data is listed.

Option Explicit
Sub test123()

Dim ws As Worksheet
Dim ws1 As Worksheet

Set ws = ThisWorkbook.Worksheets("DATA")
Set ws1 = ThisWorkbook.Worksheets("AVS")
Dim lastRow, myLoop, newValue
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).row
Dim AVS As Range
Application.ScreenUpdating = False


Range("A" & lastRow).ClearContents

For myLoop = 1 To lastRow

On Error Resume Next
   AVS = MID(ws.Range("A1:A" & myloop).Value, 1, 3)
   If IsError(AVS.Value) Then
    If Err.Number <> 0 Then
            Err.Clear
            On Error GoTo 0
        End If


Else
   If AVS = "AVS" Then
      'If MID(ws.Range("A1:A" & lastRow).Value, 1, 3) = "AVS" Then
         newValue = MID(ws.Range("A" & myLoop).Value, 48, 4)

    End If
End If
        ws1.Range("A" & myLoop).Value = newValue

Next

 Application.ScreenUpdating = True
End Sub

I've also listed below a sample of the data I'm trying to retrieve from on the "Data" sheet. Sample Data

Thank you for all the help!


Solution

  • Thanks to @ScottHoltman and @Gaffi I managed to get my code to loop with the following:

    Sub AVS()
    
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    
    Set ws = ThisWorkbook.Worksheets("DATA")
    Set ws1 = ThisWorkbook.Worksheets("AVS")
    Dim lastRow, myLoop, newValue
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).row
    Application.ScreenUpdating = False
    
    
    Range("A" & lastRow).ClearContents
    
    For myLoop = 1 To lastRow
    
       If MID(ws.Range("A" & myLoop).Value, 1, 3) = "AVS" Then
          newValue = MID(ws.Range("A" & myLoop).Value, 48, 4)
    End If
    
            ws1.Range("A" & myLoop).Value = newValue
    
    Next
    
     Application.ScreenUpdating = True
    End Sub
    

    It did raise another issue that I will resolve with another post. thanks.