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!
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.