Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
matching 2 values with a singel value
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. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
matching 2 values with a singel value
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. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
matching 2 values with a singel value
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 -- Regards, Tom Ogilvy "davegb" wrote: 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. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
matching 2 values with a singel value
Tom Ogilvy wrote: 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 -- Regards, Tom Ogilvy 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? "davegb" wrote: 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. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
matching 2 values with a singel value
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. -- Regards, Tom Ogivy "davegb" wrote: Tom Ogilvy wrote: 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 -- Regards, Tom Ogilvy 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? "davegb" wrote: 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. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
matching 2 values with a singel value
Tom Ogilvy wrote: 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. -- Regards, Tom Ogivy Ok, so my explanation confused you. Thanks for clearing it up for me. "davegb" wrote: Tom Ogilvy wrote: 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 -- Regards, Tom Ogilvy 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? "davegb" wrote: 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. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Combined cells to a singel cell | Excel Worksheet Functions | |||
can you have 2 different colors in a singel cell? | Excel Discussion (Misc queries) | |||
Finding Most Recent Values in Col1 -- Summing Matching Values | Excel Discussion (Misc queries) | |||
Mail a singel sheet i an xls file. | Excel Discussion (Misc queries) | |||
Fill values into a listbox matching selected values from a combobox | Excel Programming |