VBA loop with arrays duplicating output - vba

Question

I'm new to using arrays (and VBA in general) and I'm trying to incorporate a series of arrays into a module that formats SPSS syntax output in worksheets in a single workbook. Below is my code, which works, but is duplicating the results that are found. I think it has something to do with the order of my loops but I can't seem to figure out how to fix it. Any thoughts would be greatly appreciated.
Sub FindValues()
Call CreateSummary
'This code will build the initial summary file
Dim ws As Excel.Worksheet
'Application.ScreenUpdating = False
MsgBox ("It will take a moment for data to appear, please be patient if data does not immediately appear")
Dim LastRow As Long
Dim i As Integer
Dim i2 As Integer
Dim x As Integer
Dim y As Integer
Dim CopiedRows As Integer
Dim LocationA(4) As String
Dim LocationB(4) As String
Dim LocationC(4) As String
Dim LocationD(4) As String
Dim VariableA(4) As Integer
Dim VariableB(4) As Integer
Dim ColumnA(4) As String
Dim ColumnB(4) As String
Dim n As Long
'Find DateTime Info
LocationA(1) = "Date_Time"
LocationB(1) = "Quarter"
LocationC(1) = "N"
LocationD(1) = "Minimum"
VariableA(1) = 1
VariableB(1) = 1
ColumnA(1) = "B"
ColumnB(1) = "C"
LocationA(2) = "Dur*"
LocationB(2) = "Methodology_ID"
LocationC(2) = "Mean"
LocationD(2) = "N"
VariableA(2) = 1
VariableB(2) = 1
ColumnA(2) = "C"
ColumnB(2) = "D"
LocationA(3) = "WebTimeout"
LocationB(3) = "Methodology_ID"
LocationC(3) = "Mean"
LocationD(3) = "N"
VariableA(3) = 1
VariableB(3) = 1
ColumnA(3) = "C"
ColumnB(3) = "D"
'LocationA(4) = "Crosstabulation"
'LocationB(4) = "Quarter"
'LocationC(4) = "N"
'LocationD(4) = "Minimum"
'VariableA(4) = 1
'Find OSAT Data
'LocationA(2) = "*Report*"
'LocationB(2) = "*CallMonth*"
'LocationC(2) = "Mean*"
'LocationD(2) = "*Overall*"
'VariableA(2) = 2
For Each ws In Application.ThisWorkbook.Worksheets
'Starting row
i = 1
'Find LastRow
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
If ws.Name <> "Run Macros" Then
Do While i <= LastRow
For x = 1 To 3
If ws.Range("A" & i).Value Like LocationA(x) And ws.Range("A" & i + 1).Value Like LocationB(x) And ws.Range(ColumnA(x) & i + VariableA(x)).Value Like LocationC(x) And ws.Range(ColumnB(x) & i + VariableB(x)).Value Like LocationD(x) Then
CopiedRows = 0
i2 = i
Do While ws.Range("A" & i2 + 1).Borders(xlEdgeLeft).LineStyle = 1 And ws.Range("A" & i2 + 1).Borders(xlEdgeLeft).Weight = 4
i2 = i2 + 1
CopiedRows = CopiedRows + 1
Loop
n = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 4
ws.Rows(i & ":" & i + CopiedRows).Copy Sheets("Summary").Range("A" & n)
On Error Resume Next
End If
Next x
i = i + 1
Loop
End If
Next
'Application.ScreenUpdating = True
End Sub

Answer 1

This works if anyone want to reuse this code...
For x = 1 To 3 Step 1
For Each ws In Application.ThisWorkbook.Worksheets
'Starting row
i = 1
'Find LastRow
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Do While i <= LastRow
If ws.Name <> "Run Macros" Or ws.Name <> "Summary" Then
If ws.Range("A" & i).Value Like LocationA(x) And ws.Range("A" & i + 1).Value Like LocationB(x) And ws.Range(ColumnA(x) & i + VariableA(x)).Value Like LocationC(x) And ws.Range(ColumnB(x) & i + VariableB(x)).Value Like LocationD(x) Then
CopiedRows = 0
i2 = i
Do While ws.Range("A" & i2 + 1).Borders(xlEdgeLeft).LineStyle = 1 And ws.Range("A" & i2 + 1).Borders(xlEdgeLeft).Weight = 4
i2 = i2 + 1
CopiedRows = CopiedRows + 1
Loop
n = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 4
ws.Rows(i & ":" & i + CopiedRows).Copy Sheets("Summary").Range("A" & n)
Exit For
On Error Resume Next
End If
End If
i = i + 1
Loop
Next
Next x