Need a macro that compares the location on a spreadsheet and places blanks across the entire row in the sheet if they don"t match up. I have one that does this for A and B but I have to copy and paste the locations in those columns then manually go back and manipulate the the sheet, example:As you can see the 7th row has been moved down to match the 8th. This usually extends from column A to O.
<colgroup><col><col><col><col><col><col><col><col><col><col span="2"></colgroup><tbody>
</tbody> This is the macro for the A and B columns:
Sub test()
Dim w, n As Long, a As Range, x As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
n = Range("A:B").Find("*", after:=[a1], searchdirection:=xlPrevious, searchorder:=xlByRows).Row
w = Range("A1:B" & n)
Range("AA1:AB" & n) = w
Cells(n + 1, 1) = Chr(255): Cells(n + 1, 2) = Chr(255)
Set a = Cells(1, 1).Resize(n + 1, 2)
a.Resize(, 1).Sort a(1, 1), 1, Header:=xlYes
a.Resize(, 1).Offset(, 1).Sort a(1, 2), 1, Header:=xlYes
Do
x = x + 1
If a(x, 1) > a(x, 2) Then
a(x, 1).Insert xlDown
ElseIf a(x, 1) < a(x, 2) Then
a(x, 2).Insert xlDown
End If
If x > 10 ^ 4 Then Exit Do
Loop Until a(x, 1) = Chr(255) And a(x, 1) = Chr(255)
Cells(x, 1).Resize(1, 2).ClearContents
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Any help would be much appreciated!
<colgroup><col><col><col><col><col><col><col><col><col><col span="2"></colgroup><tbody></tbody>.
Item number | Product name | Location | Physical inventory | Counted | Item number | Product name | Location | Physical inventory | Count | |
1 | Boomer Rang | BA-01-1-1 | 195.00 | 195.00 | 1 | Boomer Rang | BA-01-1-1 | 195.00 | 195.00 | |
2 | Boomer Rang | BA-01-2-1 | 60.00 | 60.00 | 2 | Boomer Rang | BA-01-2-1 | 60.00 | 60.00 | |
3 | Boomer Rang | BA-01-2-2 | 1,100.00 | 1,100.00 | 3 | Boomer Rang | BA-01-2-2 | 1,100.00 | 1,100.00 | |
4 | Boomer Rang | BA-01-2-4 | 6.00 | 6.00 | 4 | Boomer Rang | BA-01-2-4 | 6.00 | 6.00 | |
5 | Boomer Rang | BA-01-2-5 | 500.00 | 500.00 | 5 | Boomer Rang | BA-01-2-5 | 500.00 | 500.00 | |
6 | Boomer Rang | BA-01-3-1 | 1,600.00 | 1,600.00 | 6 | Boomer Rang | BA-01-3-1 | 1,600.00 | 1,600.00 | |
7 | Boomer Rang | BA-01-3-2 | 3,500.00 | 3,500.00 | ||||||
7 | Boomer Rang | BA-01-3-3 | 1,800.00 | 1,800.00 | 8 | Boomer Rang | BA-01-3-3 | 1,600.00 | 1,600.00 | |
8 | Boomer Rang | BA-01-4-1 | 2,200.00 | 2,200.00 | 9 | Boomer Rang | BA-01-4-1 | 2,200.00 | 2,200.00 | |
9 | Boomer Rang | BA-01-4-2 | 2,100.00 | 2,100.00 | 10 | Boomer Rang | BA-01-4-2 | 2,100.00 | 2,100.00 | |
10 | Boomer Rang | BA-01-4-3 | 1,500.00 | 1,500.00 | 11 | Boomer Rang | BA-01-4-3 | 1,500.00 | 1,500.00 | |
11 | Boomer Rang | BA-02-1-1 | 200.00 | 200.00 | 12 | Boomer Rang | BA-02-1-1 | 200.00 | 200.00 | |
12 | Boomer Rang | BA-02-1-3 | 300.00 | 300.00 | 13 | Boomer Rang | BA-02-1-3 | 300.00 | 300.00 | |
13 | Boomer Rang | BA-02-2-4 | 800.00 | 800.00 |
<colgroup><col><col><col><col><col><col><col><col><col><col span="2"></colgroup><tbody>
</tbody>
Sub test()
Dim w, n As Long, a As Range, x As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
n = Range("A:B").Find("*", after:=[a1], searchdirection:=xlPrevious, searchorder:=xlByRows).Row
w = Range("A1:B" & n)
Range("AA1:AB" & n) = w
Cells(n + 1, 1) = Chr(255): Cells(n + 1, 2) = Chr(255)
Set a = Cells(1, 1).Resize(n + 1, 2)
a.Resize(, 1).Sort a(1, 1), 1, Header:=xlYes
a.Resize(, 1).Offset(, 1).Sort a(1, 2), 1, Header:=xlYes
Do
x = x + 1
If a(x, 1) > a(x, 2) Then
a(x, 1).Insert xlDown
ElseIf a(x, 1) < a(x, 2) Then
a(x, 2).Insert xlDown
End If
If x > 10 ^ 4 Then Exit Do
Loop Until a(x, 1) = Chr(255) And a(x, 1) = Chr(255)
Cells(x, 1).Resize(1, 2).ClearContents
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Any help would be much appreciated!
<colgroup><col><col><col><col><col><col><col><col><col><col span="2"></colgroup><tbody></tbody>