The Function of the program is to find the first row that has an empty cell, next to that cell is a number that needs to be cut and pasted in the previous row on column 26.
-I am trying to run a loop that goes through the entire sheet and deletes the row once copied and pasted.
-If there is already data inside it will skip it and continue on.
-The Second Method is my most promising but I just can't seem to find out how to run the format of Cells(x,1)
(Method One)
Dim x As Integer
x = 1
this = x - 1
rowdelete = x
If Cells(x, 1) = "" Then
Cells(x, 1).Select.Cut
Cells(x - 1, 26).PasteSpecial
Rows([rowdelete]).EntireRow.Delete
End If
(Method Two)
Dim x As Integer
x = 1
this = x - 1
rowdelete = x
If Cells(x, 1) = "" Then
Cells(x, 1).Select.Cut
Cells(x - 1, 26).PasteSpecial
Rows([rowdelete]).EntireRow.Delete
End If
I don't know if i'm just missing something but your Method1 and Method2 look identical to me. I think your issue was that you were trying to paste to Row 0 which doesn't exist. It's also good practice to define all your ranges and cells or excel will take whatever is active at the time.
Try the below code that loops through blank cells in Col A and doesn't use the Clipboard which should make things much faster for you.
Sub LoopThroughBlanks()
Dim wbk As Workbook
Dim ws As Worksheet
Dim lRow As Long
Dim Cell As Range
Set wbk = ActiveWorkbook
Set ws = wbk.Worksheets("Sheet1") 'Be sure to change this to your worksheet name!
With ws
'Find last row of data in worksheet
lRow = .Cells.Find(What:="*", _
After:=.Cells(1, 1), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'Loop through blank cells in col a
For Each Cell In .Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks)
If Cell.Row = 1 Then
.Range("A1").EntireRow.Insert
End If
'Copy to column 26
Cell.Offset(-1, 25).Value = Cell.Offset(0, 1).Value
.Rows(Cell.Row).EntireRow.Delete
Next Cell
End With
End Sub
Related
I am new to macro writing and I need some help.
I have one sheet and need to copy the columns and reorder them to paste into a software program.
I want to copy A2 - the last data entry in column A and paste it into A1 on Sheet2
I want to copy B2 - the last data entry in column A and paste it into K1 on Sheet2
I want to copy C2 - the last data entry in column A and paste it into C1 on Sheet2
I want to copy D2 - the last data entry in column A and paste it into D1 on Sheet2
Then from Sheet 2, I want to copy A1:KXXXX (to the last entry in column A) and save it on the clipboard to paste into the other application
Here is my code, I have tried... (I know this is just for copying column A, but I got stuck there.)
Sub Copy()
aLastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("A2" & aLastRow).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
Thank you so much for your help!
Jess
Try this instead. Given that you said you got an error with the paste code and I am still using that, I think you'll still have an error there. Post the error message. Hopefully we can figure that out.
Sub copyStuff()
Dim wsIn As Worksheet
Set wsIn = Application.Worksheets("Sheet1")
Dim endRow As Long
wsIn.Activate
endRow = wsIn.Cells(wsIn.Rows.Count, "A").End(xlUp).Row
Dim r As Range
Dim wsOut As Worksheet
Set wsOut = Application.Worksheets("Sheet2")
' column a to column a
Set r = wsIn.Range(Cells(2, 1), Cells(endRow, 1))
r.Copy
wsOut.Range("A1").PasteSpecial xlPasteAll
' column b to column k
Set r = wsIn.Range(Cells(2, 2), Cells(endRow, 2))
r.Copy
wsOut.Range("K1").PasteSpecial xlPasteAll
' column c to column c
Set r = wsIn.Range(Cells(2, 3), Cells(endRow, 3))
r.Copy
wsOut.Range("C1").PasteSpecial xlPasteAll
' column d to column d
Set r = wsIn.Range(Cells(2, 4), Cells(endRow, 4))
r.Copy
wsOut.Range("D1").PasteSpecial xlPasteAll
' Copy data from sheet 2 into clipboard
wsOut.Activate
Set r = wsOut.Range(Cells(1, 1), Cells(endRow - 1, 11))
r.Copy
End Sub
My original answer is below here. You can disregard.
This should accomplish your first goal:
Sub copyStuff()
Dim wsIn As Worksheet
Set wsIn = Application.Worksheets("Sheet1")
Dim endRow As Long
endRow = wsIn.Cells(wsIn.Rows.Count, "A").End(xlUp).Row
Dim r As range
Set r = wsIn.range(Cells(2, 1), Cells(endRow, 4))
r.Copy
Dim wsOut As Worksheet
Set wsOut = Application.Worksheets("Sheet2")
wsOut.range("A1").PasteSpecial xlPasteAll
End Sub
I copied all 4 columns at once since that would be much faster but it assumes the columns are the same length. If that isn't true you would need to copy one at a time.
The data should be in the clipboard at the end of the macro.
Edit: I removed "wsIn.Activate" since it isn't really needed.
Edit 2: Oops! I just noticed you wanted the output in different columns. I'll work on it.
Generally you want to avoid .Select and .Paste when copying values and rather copy by .value = .value:
Sub Copy()
Dim aLastRow As Long
Dim clipboard As MSForms.DataObject
Set clipboard = New MSForms.DataObject
aLastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet2").Range("A1:A" & aLastRow - 1).Value = Sheets("Sheet1").Range("A2:A" & aLastRow).Value
Sheets("Sheet2").Range("K1:K" & aLastRow - 1).Value = Sheets("Sheet1").Range("B2:B" & aLastRow).Value
Sheets("Sheet2").Range("C1:D" & aLastRow - 1).Value = Sheets("Sheet1").Range("C2:D" & aLastRow).Value
clipboard.SetText Sheets("Sheet2").Range("A1:K" & aLastRow - 1).Value
clipboard.PutInClipboard
End Sub
I am copying information from one workbook to another. The code I have so far works great if every column has data. It does not work when I am trying to repeatedly copy information from column A and B of worksheet(supplementary expenses) to worksheet(expenses) and column B is blank. As the next time the sub is run and Column B does have values they are placed in the next blank cell, not the cell that is correlated to column A.
Here is the code I have so far:
Sub SupplementaryExpenses()
Dim x As Workbook
Dim y As Workbook
Set y = Workbooks.Open("File Path")
Set x = Workbooks.Open("File Path")
x.Sheets("b.1 Supplementary expenses").Range("a9", Range("a9").End(xlDown)).Copy
y.Sheets("Expenses").Range("a1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
x.Sheets("b.1 Supplementary expenses").Range("b9", Range("b9").End(xlDown)).Copy
y.Sheets("Expenses").Range("b1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
x.Sheets("b.1 Supplementary expenses").Range("c9", Range("c9").End(xlDown)).Copy
y.Sheets("Expenses").Range("c1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Also any time this sub is run it would be helpful if there were someway to fill column L with the flag 201601 and then change to 201602 when I bring in the next months data.
Try this:
Sub SupplementaryExpenses()
Dim x As Workbook
Dim y As Workbook
Dim lastrow As Long
Dim tRow as long
Set y = Workbooks.Open("File Path")
Set x = Workbooks.Open("File Path")
With x.Sheets("b.1 Supplementary expenses")
lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
tRow = y.Sheets("Expenses").Range("a1").End(xlDown).Offset(1, 0).Row
y.Sheets("Expenses").Range("A" & trow).Resize(lastrow - 8, 3).Value = .Range(.Cells(9, 1), .Cells(lastrow, 3)).Value
y.Sheets("Expenses").Range("D" & trow).Resize(lastrow - 8, 1).Value = .Range(.Cells(9, 8), .Cells(lastrow, 8)).Value
End With
End Sub
It will take all of the three columns at once and assign the values to the new area. It will not care about blanks in column B or C.
This should be faster than copy/paste as you only want the values.
Get the last used row and change out your range statements similar to this:
Dim LastRow
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
x.Sheets("b.1 Supplementary expenses").Range(Cells(9, 1), Cells(LastRow, a)).Copy 'this is R1C1 format meaning row then column
You can use this for filling a column
If you put it after the rest of your code and ensure that you have the sheet you want column L populated with active:
sDate = Format(Date, "yyyymm")
For i = 2 To LastRow' you may need to grab this anew if you added lines
If Cells(i, "L") = vbNullString Then 'ensures that there isn't anything in the cell
Cells(i, "L").value = sDate
End If
Next
I would appreciate any help on this matter. I am trying to create an Excel 2010 macro in VBA that will read strings in one spreadsheet row by row, and then search another spreadsheet to see if the value exists in a column of strings.
If/When it finds a matching string in column A, I would like to compare the string in column C of the original spreadsheet with the string in Column C of the spreadsheet being searched. If both strings are the same, I would like to move on back to the column A search and continue.
If the strings are different I would like to overwrite the string in Column C of the spreadsheet being searched. I would also like to highlight this change on the searched spreadsheet.
If no matching string is found in column A of the search spreadsheet, then I want to copy the row of the original spreadsheet into the searched spreadsheet and highlight it.
Here's what I have so far, but I can't seem to get it to work properly:
Sub SearchRows()
Dim bottomA1 As Integer
bottomA1 = Sheets("Original Spreadsheet").Range("A" & Rows.Count).End(xlUp).Row
Dim bottomA2 As Integer
bottomA2 = Sheets("Searched Spreadsheet").Range("A" & Rows.Count).End(xlUp).Row
Dim rng1 As Range
Dim rng2 As Range
Dim x As Long
Dim y As Long
Dim foundColumnA As Range
Dim foundColumnC As Range
For Each rng1 In Sheets("Original Spreadsheet").Range("A2:A" & bottomA1)
With Sheets("Searched Spreadsheet").Range("A2:A" & bottomA2)
Set foundColumnA = .Find(what:=rng1, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
For Each rng2 In Sheets("Original Spreadsheet").Range("E2:E" & bottomA1)
With Sheets("Searched Spreadsheet").Range("E2:E" & bottomA2)
Set foundSize = .Find(what:=rng2, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
If foundColumnC Is Nothing Then
bottomE2 = Sheets("Column C Changes").Range("E" & Rows.Count).End(xlUp).Row
y = bottomA2 + 1
rng2.EntireRow.Copy Sheets("Column C Changes").Cells(y, "A")
Sheets("Column C Changes").Cells (y, "A").EntireRow.Interior.ColorIndex = 4
End If
End With
Next rng2
If foundTag Is Nothing Then
bottomA2 = Sheets("Column A Changes").Range("A" & Rows.Count).End(xlUp).Row
x = bottomA2 + 1
rng1.EntireRow.Copy Sheets("Column A Changes").Cells(x, "A")
Sheets("Column A Changes").Cells(x, "A").EntireRow.Interior.ColorIndex = 3
End If
End With
Next rng1
End Sub
You actually have too much code, but they're not set up cleanly. Qualify a lot of things as much as possible so it's cleaner, and try to be consistent with your style. This way you can identify the error as much as possible.
Anyway, on to the code. The basic logic you want is as follows, based on the details above:
Check if a string in Sheet1!A is in Sheet2!A.
If found, compare Column C values.
If Column C values are different, set value of Sheet2 to that in Sheet1 and highlight.
Else, exit.
If not found, copy whole row to Sheet2 and highlight.
Now that we have that written down, it's simpler! :)
Please check my screenshots for my set-up:
SCREENSHOTS:
Sheet1:
Sheet2:
Note that for Sheet2, I don't have BK207 onwards. ;) Now, onto the code.
CODE:
Sub LoopMatchReplace()
Dim ShSrc As Worksheet, ShTar As Worksheet
Dim SrcLRow As Long, TarLRow As Long, NextEmptyRow As Long
Dim RefList As Range, TarList As Range, RefCell As Range, RefColC
Dim TarCell As Range, TarColC As Range
Dim IsFound As Boolean
Dim ToFind As String
With ThisWorkbook
Set ShSrc = .Sheets("Sheet1")
Set ShTar = .Sheets("Sheet2")
End With
'Get the last rows for each sheet.
SrcLRow = ShSrc.Range("A" & Rows.Count).End(xlUp).Row
TarLRow = ShTar.Range("A" & Rows.Count).End(xlUp).Row
'Set the lists to compare.
Set RefList = ShSrc.Range("A2:A" & SrcLRow)
Set TarList = ShTar.Range("A2:A" & TarLRow)
'Initialize boolean, just for kicks.
IsFound = False
'Speed up the process.
Application.ScreenUpdating = False
'Create the loop.
For Each RefCell In RefList
ToFind = RefCell.Value
'Look for the value in our target column.
On Error Resume Next
Set TarCell = TarList.Find(ToFind)
If Not TarCell Is Nothing Then IsFound = True
On Error GoTo 0
'If value exists in target column...
If IsFound Then
'Compare the Column C of both sheets.
Set TarColC = TarCell.Offset(0, 2)
Set RefColC = RefCell.Offset(0, 2)
'If they are different, set the value to match and highlight.
If TarColC.Value <> RefColC.Value Then
TarColC.Value = RefColC.Value
TarColC.Interior.ColorIndex = 4
End If
Else 'If value does not exist...
'Get next empty row, copy the whole row from source sheet, and highlight.
NextEmptyRow = ShTar.Range("A" & Rows.Count).End(xlUp).Row + 1
RefCell.EntireRow.Copy ShTar.Rows(NextEmptyRow)
ShTar.Rows(NextEmptyRow).SpecialCells(xlCellTypeConstants).Interior.ColorIndex = 3
End If
'Set boolean check to False.
IsFound = False
Next RefCell
Application.ScreenUpdating = True
End Sub
Kindly read the comments for the codeblocks so you get an understanding of what I'm doing. Also, note the way that I have qualified everything and properly set them up in a very clean way. Clean code is 50% good code.
Check the following screenshot to see the results after running the code.
END RESULT:
Note the added rows at the end and the changed values in Column C. I did not have the whole row highlighted as I believe that's bad practice and messy, but it's up to you to change the respective lines and values to suit your taste for the end result.
Let us know if this helps.
I think you can use this code.
Values not found will be added to the end of destination sheet.
Differences are signed with a blue(change if you want) background color.
Sub copy_d()
Dim r1 As Long, rfound, vfound
Dim w1, w2, v, lastR As Long, lastC As Long
Set w1 = Sheets("sheet1") ' change the origin sheet at will
Set w2 = Sheets("sheet2") ' change the destination sheet at will
r1 = 1 ' assuming data start in row 1, change it if not
Do While Not IsEmpty(w1.Cells(r1, 1))
v = w1.Cells(r1, 1)
rfound = Application.Match(v, w2.Columns(1), 0) ' look for value
If Not IsError(rfound) Then ' found it?
vfound = w2.Cells(rfound, 3)
If w1.Cells(r1, 3) <> vfound Then ' value in column C is different?
w2.Cells(rfound, 3) = w1.Cells(r1, 3) ' update based on origin sheet
lastC = w2.Cells(rfound, 1).End(xlToRight).Column
w2.Range(w2.Cells(rfound, 1), w2.Cells(rfound, lastC)).Interior.ColorIndex = 5
End If
Else
lastR = w2.Cells(1, 1).End(xlDown).Row + 1
w1.Rows(r1).copy Destination:=w2.Rows(lastR) ' copy to last row of dest sheet
lastC = w2.Cells(lastR, 1).End(xlToRight).Column
w2.Range(w2.Cells(lastR, 1), w2.Cells(lastR, lastC)).Interior.ColorIndex = 5
End If
r1 = r1 + 1
Loop
End Sub
I am trying to use a macro to clean up data files and only copy on Sheet2 what is most relevant.
I have written the code to find the row I want the data to be copied from. However I can only copy the row itself and not the range underneath. Please note I need the range to go from that row to the last column and last row as the size of the matriz always varies.
s N s N s N s N s rpm
Linear Real Linear Real Linear Real Linear Real Linear Amplitude
0.0000030 9853.66 0.0000030 5951.83 0.0000030 533.48 0.0000030 476.15 0.0000030 2150.16
0.0000226 9848.63 0.0000226 5948.19 0.0000226 557.02 0.0000226 488.60 0.0000226 2150.16
0.0000421 9826.05 0.0000421 5956.22 0.0000421 615.94 0.0000421 480.75 0.0000421 2150.15
0.0000616 9829.72 0.0000616 5989.72 0.0000616 642.59 0.0000616 476.77 0.0000616 2150.15
So basically the code below finds that first row and copies it in Sheet2. I need the macro to also select the range underneath and copy it onto Sheet2. Please can you help me finishing off the script?
Sub SearchForRawData()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
On Error GoTo Err_Execute
'Start search in row 1
LSearchRow = 1
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2
While Len(Range("A" & CStr(LSearchRow)).Value) >= 0
'If value in column A = "s", copy entire row to Sheet2
If Range("A" & CStr(LSearchRow)).Value = "s" Then
'Select row and range in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet2 in next row
Sheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Select all Raw Data underneath found Row to Copy
'Paste all Raw Data into Sheet 2
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A1
Application.CutCopyMode = False
Range("A1").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error has occured"
End Sub
You don't need a loop for this if you want to copy the row that has the "s" and everything below it to the target sheet. The following sub finds the row with the "s" in column A and then copies that row and everything below it to the target sheet.
Note that you should always avoid selecting or activating anything in VBA code, and that the normal way to copy and paste relies on selecting. If you use the syntax I've included here, the clipboard is not used and the target sheet does not need to be selected.
Sub CopyRowAndBelowToTarget()
Dim wb As Workbook
Dim src As Worksheet
Dim tgt As Worksheet
Dim match As Range
Set wb = ThisWorkbook
Set src = wb.Sheets("Sheet1")
Set tgt = wb.Sheets("Sheet2")
Dim lastCopyRow As Long
Dim lastPasteRow As Long
Dim lastCol As Long
Dim matchRow As Long
Dim findMe As String
' specify what we're searching for
findMe = "s"
' find our search string in column A (1)
Set match = src.Columns(1).Find(What:=findMe, After:=src.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
' figure out what row our search string is on
matchRow = match.Row
' get the last row and column with data so we know how much to copy
lastCopyRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
lastCol = src.Cells(1, src.Columns.Count).End(xlToLeft).Column
' find out where on our target sheet we should paste the results
lastPasteRow = tgt.Range("A" & src.Rows.Count).End(xlUp).Row
' use copy/paste syntax that doesn't use the clipboard
' and doesn't select or activate
src.Range(Cells(matchRow, 1), Cells(lastCopyRow, lastCol)).Copy _
tgt.Range("A" & lastPasteRow)
End Sub
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
So firstly you don't acutally need the CStr, vba will cast numbers to strings by itself, i.e. Range(LSearchRow & ":" & LSearchRow) should work fine.
To find how many rows down to go use the end function of the range object:
bottomRow = Range("A" & LSearchRow).End(xldown).Row
Do the same for the column
lastCol = Range("A" & LSearchRow).End(xlleft).column
Now to copy:
Range("A" & LSearchRow & ":" & lastCol & bottomRow).Copy
However if you have empty cells inthe middleof the data then instead of using End(xldown), start at the bottom of the sheet and look up:
bottomRow = Range("A1000000").End(xlup).Row
etc
I have an Macro Based Excel file that generates a list of items received and their status (i.e. received, repaired, etc). This program runs daily, and right now I have it capture the previous day's list and place it in a spreadsheet called PreviousData before updating with the current day's list, which is placed in a spreadsheet called Data; this is used to compare what we believe we fixed/changed status on the previous day.
I'm basically self taught in VBA, so I'm not super efficient or experienced. What I want to do is the following:
On the Data Spreadsheet, grab the order number starting in J2
Switch to the PreviousData Spreadsheet, and search for the order number from step 1
Scenario A: If the order number is found on PreviousData, compare the status values next to the order number on both sheets; if they differ, run some code otherwise do nothing
Scenario B: If the order number is not found on PreviousData, do nothing
Repeat until 1st blank cell encountered in Data Spreadsheet
I did some searching around the interwebs and found something (it might have been from this forum, actually) that would go row by row and compare cell values, but if scenario B came up the function would fail with "out of range." Here is the code I tried and have modified to try to get to work:
Sub output()
Dim varSheetA As Variant
Dim varSheetB As Variant
Dim varSheetRMA As Variant
Dim strRangeToCheck As String
Dim strRangeRMA As String
Dim Variable As String
Dim iRow As Long
Dim iCol As Long
Dim Count As Integer
strRangeToCheck = "K2:L1000"
strRangeRMA = "J2:J1000"
' If you know the data will only be in a smaller range, reduce the size of the ranges above.
Debug.Print Now
varSheetA = Worksheets("PreviousData").Range(strRangeToCheck)
varSheetB = Worksheets("Data").Range(strRangeToCheck) ' or whatever your other sheet is.
varSheetRMA = Worksheets("Data").Range(strRangeRMA)
Debug.Print Now
Sheets("Data").Select
Range("J2").Select
Selection.Copy
Sheets("PreviousData").Select
Cells.Find(What:=Variable, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
' Cells are identical.
' Do nothing.
Else
' Cells are different.
' Code goes here for whatever it is you want to do.
End If
Next iCol
Next iRow
End Sub
Please help :)
This code should be easier to understand + it does the job.
Option Explicit
Sub CompareStatuses()
Dim ws1 As Worksheet, ws2 As Worksheet, rng1 As Range, rng2 As Range
Dim lr1&, lr2&, i&, j&
Set ws1 = ThisWorkbook.Sheets("Data")
Set ws2 = ThisWorkbook.Sheets("PreviousData")
lr1 = ws1.Range("J" & Rows.Count).End(xlUp).Row
lr2 = ws2.Range("J" & Rows.Count).End(xlUp).Row
For i = 2 To lr1
For j = 2 To lr2
Set rng1 = ws1.Range("J" & i)
Set rng2 = ws2.Range("J" & j)
If StrComp(CStr(rng1.Value), CStr(rng2.Value), vbTextCompare) = 0 And _
StrComp(CStr(rng1.Offset(0, 1).Value), CStr(rng2.Offset(0, 1).Value) _
,vbTextCompare) <> 0 Then
' found a matching Order + both statuses are different
' this is where you wanted to run some code
End If
Set rng1 = Nothing
Set rng2 = Nothing
Next j
Next i
End Sub