matching 2 values with a singel value

[davegb]

I am comparing a list of values in 2 spreadsheets sorted on that
value. When I find a value missing in one sheet, I insert a blank row
into that sheet the corresponds to the row in the other sheet, so the
matching values in each sheet are in corresponding rows. No problem,
until I get to the end. I'm trying to figure out how to tell the macro
to enter any final rows neccessary to "match" the 2 sheets and then
end. I can easily get the highest value in the corresponding columns
(Column A in both cases) in either of the 2 sheets. But how to write
the code so that when the macro gets to that final value, it enters any
necessary corresponding blank lines to the other sheet before ending?

To start, the sheets would look like this:

Sheet A Sheet B
1 1
2 2
4 3
5 5
6 6
9 8
12

After the macro runs, they'd look like:

Sheet A Sheet B
1 1
2 2
3
4
5 5
6 6
8
9
12

Since the 12 could be in either spreadsheet and I want to put in the
blank line for the 12 in the corresponding spreadsheet, if needed, I
don't know how to end the macro or what kind of loop to use. This has
got to be a common kind of thing.

So far, I have:

Sub ClientStateIDMatchSubmital()

Dim lOrigCSID As Long
Dim lNewLstMax As Long
Dim lOrigLstMax As Long
Dim lCurRow As Long
Dim rFoundCell As Range
Dim rOrigCSID As Range
Dim rCell As Range
Dim lRow As Long
Dim lOrig As Long
Dim lNew As Long
Dim lCtySrcCol As Long
Dim lOrigCount As Long
Dim lNewCount As Long
Dim wbOrig As Workbook
Dim wbNew As Workbook
Dim lLimit As Long
Dim rNewCSID As Range
Dim wsNew As Worksheet
Dim wsOrig As Worksheet


lOrigCount = 0
lNewCount = 0

Set wbOrig = Workbooks("testorig.xls")
Set wbNew = Workbooks("testnew.xls")
Set wsOrig = wbOrig.Worksheets("sheet1")
Set wsNew = wbNew.Worksheets("sheet1")

'Determine which sheet has the highest value and set limit variable

With wsOrig
.Activate
'.Range("a2").Select
lOrigLstMax = .Cells(Rows.Count, "A").End(xlUp).Value
'Set rOrigCSID = .Range(.Cells(2, 1), .Cells(lEndRow, "A"))
End With


With wsNew
.Activate
lNewLstMax = .Cells(Rows.Count, "A").End(xlUp).Value
End With

If lNewLstMax > lOrigLstMax Then
lLimit = lNewLstMax
Else
lLimit = lOrigLstMax
End If


lCurRow = 1

Do Until ????= lLimit <WHAT KIND OF LOOP, AND HOW TO END IT?

lCurRow = lCurRow + 1
lOrig = wsOrig.Cells(lCurRow, 1).Value
lNew = wsNew.Cells(lCurRow, 1).Value


If lOrig <> lNew Then
If lNew > lOrig Then
wbNew.Activate
wsNew.Cells(lCurRow, 1).Select
Selection.EntireRow.Insert
lOrigCount = lOrigCount + 1
Else
wbOrig.Activate
wsOrig.Cells(lCurRow, 1).Select
Selection.EntireRow.Insert
lNewCount = lNewCount + 1

End If
End If

Loop

Finish:
'Application.Run "'My Addin.xla'!MyMacro"

End Sub

Thanks in advance.

 

[davegb]

I should have mentioned that this is easy to do if I put in nested IF
statements at the end that just test and end the sub. But I'm told this
is "bad programming" and will be drummed out of the corps is I do such
things.

 

[Guest]

It appears there are header rows in each sheet and the matching starts in row
2:

Sub EvenOutRows()
Dim wbOrig As Workbook
Dim wbNew As Workbook
Dim wsNew As Worksheet
Dim wsOrig As Worksheet
Dim li As Long, lDiff As Long
Dim lrowNew As Long, lrowOrig As Long
Set wbOrig = Workbooks("testorig.xls")
Set wbNew = Workbooks("testnew.xls")
Set wsOrig = wbOrig.Worksheets("sheet1")
Set wsNew = wbNew.Worksheets("sheet1")
li = 2
Do While Not IsEmpty(wsNew.Cells(li, 1)) And _
Not IsEmpty(wsOrig.Cells(li, 1))
If wsNew.Cells(li, 1) > wsOrig.Cells(li, 1) Then
wsNew.Rows(li).Insert: li = li + 1
ElseIf wsOrig.Cells(li, 1) > wsNew.Cells(li, 1) Then
wsOrig.Rows(li).Insert: li = li + 1
ElseIf wsNew.Cells(li, 1) = wsOrig.Cells(li, 1) Then
li = li + 1
End If
Loop
lrowNew = wsNew.Cells(Rows.Count, 1).End(xlUp).Row
lrowOrig = wsOrig.Cells(Rows.Count, 1).End(xlUp).Row
lDiff = Abs(lrowNew - lrowOrig)
If lrowNew > lrowOrig Then
wsOrig.Cells(lrowOrig + 1, 1) _
.Resize(lDiff).EntireRow.Insert
Else
wsNew.Cells(lrowNew + 1, 1) _
.Resize(lDiff).EntireRow.Insert
End If
End Sub

 

[davegb]

It appears there are header rows in each sheet and the matching starts in row
2:

Sub EvenOutRows()
Dim wbOrig As Workbook
Dim wbNew As Workbook
Dim wsNew As Worksheet
Dim wsOrig As Worksheet
Dim li As Long, lDiff As Long
Dim lrowNew As Long, lrowOrig As Long
Set wbOrig = Workbooks("testorig.xls")
Set wbNew = Workbooks("testnew.xls")
Set wsOrig = wbOrig.Worksheets("sheet1")
Set wsNew = wbNew.Worksheets("sheet1")
li = 2
Do While Not IsEmpty(wsNew.Cells(li, 1)) And _
Not IsEmpty(wsOrig.Cells(li, 1))
If wsNew.Cells(li, 1) > wsOrig.Cells(li, 1) Then
wsNew.Rows(li).Insert: li = li + 1
ElseIf wsOrig.Cells(li, 1) > wsNew.Cells(li, 1) Then
wsOrig.Rows(li).Insert: li = li + 1
ElseIf wsNew.Cells(li, 1) = wsOrig.Cells(li, 1) Then
li = li + 1
End If
Loop
lrowNew = wsNew.Cells(Rows.Count, 1).End(xlUp).Row
lrowOrig = wsOrig.Cells(Rows.Count, 1).End(xlUp).Row
lDiff = Abs(lrowNew - lrowOrig)
If lrowNew > lrowOrig Then
wsOrig.Cells(lrowOrig + 1, 1) _
.Resize(lDiff).EntireRow.Insert
Else
wsNew.Cells(lrowNew + 1, 1) _
.Resize(lDiff).EntireRow.Insert
End If
End Sub

Thanks, Tom. It ran perfectly the first try. Your assumption about
titles in row 1 was correct.

I don't understand what the code following the end of the loop does. I
remarked it out, and it worked just fine. Is that for some condition
I'm not thinking of?

 

[Guest]

I didn't see any reason for it myself, but you seemed to indicate that you
wanted blank rows inserted at the end of the list with the lowest value
(assumed there might be something below the lists). So if you put a marker
in the first empty row (in column C - not A) for each list, you will see your
marker is on the same row in both lists after the macro is run.

In your example, two blank rows are inserted after the value 8 matching the
rows in the other sheet containing 9 and 12.

 

[davegb]

I didn't see any reason for it myself, but you seemed to indicate that you
wanted blank rows inserted at the end of the list with the lowest value
(assumed there might be something below the lists). So if you put a marker
in the first empty row (in column C - not A) for each list, you will see your
marker is on the same row in both lists after the macro is run.

In your example, two blank rows are inserted after the value 8 matching the
rows in the other sheet containing 9 and 12.

Ok, so my explanation confused you. Thanks for clearing it up for me.