Home |
Search |
Today's Posts |
#41
Posted to microsoft.public.excel.programming
|
|||
|
|||
Align cells with same value - vba almost working
Clif McIrvin submitted this idea :
In Rick's code, he copies Col B below A, then sorts ... Yes, I know. I added the sort to colB in case the data was not contiguous. (As is the case after the code is run, then re-run) -- Garry Free usenet access at http://www.eternal-september.org ClassicVB Users Regroup! comp.lang.basic.visual.misc |
#42
Posted to microsoft.public.excel.programming
|
|||
|
|||
Align cells with same value - vba almost working
"GS" wrote in message
... Clif McIrvin submitted this idea : In Rick's code, he copies Col B below A, then sorts ... Yes, I know. I added the sort to colB in case the data was not contiguous. (As is the case after the code is run, then re-run) Actually, Rick's code handled that just fine as posted ... I accidentally did that while testing ... then studied his code some more to see why it didn't fail <g. His .copy didn't care that there was dis-contiguous data, and after he sorted the result the data was all contiguous again. -- Clif McIrvin (clare reads his mail with moe, nomail feeds the bit bucket :-) |
#43
Posted to microsoft.public.excel.programming
|
|||
|
|||
Align cells with same value - vba almost working
Clif McIrvin has brought this to us :
"GS" wrote in message ... Clif McIrvin submitted this idea : In Rick's code, he copies Col B below A, then sorts ... Yes, I know. I added the sort to colB in case the data was not contiguous. (As is the case after the code is run, then re-run) Actually, Rick's code handled that just fine as posted ... I accidentally did that while testing ... then studied his code some more to see why it didn't fail <g. His .copy didn't care that there was dis-contiguous data, and after he sorted the result the data was all contiguous again. This is only the case for colA. After the code runs, colB is no longer contiguous and so re-running the code puts the empty cells into the array, making the process longer than necessary. I put the line to sort so this didn't happen.<g -- Garry Free usenet access at http://www.eternal-september.org ClassicVB Users Regroup! comp.lang.basic.visual.misc |
#44
Posted to microsoft.public.excel.programming
|
|||
|
|||
Align cells with same value - vba almost working
Hi there,
This old discussion was tremendous so I feel like reactivating it for those still alive in this cyberspace. Now there is another constraint, I'll start to explain the whole thing, if you read the first post, although the explanation is different, the problem is the same with as I said one more constraint: columns. Initially only rows had to be sorted and merged. So the problem again: I have a task that I can achieve up to one point using vlookup but afterwards I need to manually add rows or columns to update the data with a new set of data. It is understood the from the first set nothing should be deleted.. Even if one row is empty from the first set is not present in the second set of data, it should remain as an empty data row (but still with its identifier). For example: 1st set col1 col2 col5 col6 A B C F 2nd set col1 col2 col6 col7 A B D F E should result in col1 col2 col5 col6 col7 A B C D E F In the result, C is an empty row as it's not in the second set but must still be present with the letter C but without any data Col5 will be empty as well as it's only present in the first set. Please find a workbook with the first set of data in one sheet, the second set in another and the expected result from it. Actually, I have coded it (it's currently the paramount of my vba algorithm level - very basic, as you can see i don't use much objects and collections. This is the reason I'm looking for help because with my way of coding this, with more than 1000 rows my code is totally inefficient. My goal is to make this task time-efficient although as i said i don't really need it. link to the file: http://www.sendspace.com/file/p0tp3l my code if you can go through it without the file --- Public optionBleuVert As Integer Sub B_SortFor() Dim wb As Workbook Dim wsMPrec1 As Worksheet Dim wsMCour2 As Worksheet Dim wsMCour100 As Worksheet Dim ws As Worksheet With Application .Calculation = xlCalculationManual .ScreenUpdating = False .DisplayAlerts = False End With Set wb = ThisWorkbook Set ws = wb.Worksheets("GLOBAL100") If ws.Cells(13, 9).Value = "actif" Then Set wsMPrec1 = wb.Worksheets("actifM0") Set wsMCour2 = wb.Worksheets("actifM1") Set wsMCour100 = wb.Worksheets("actifM10") ElseIf ws.Cells(13, 9).Value = "passif" Then Set wsMPrec1 = wb.Worksheets("passifM0") Set wsMCour2 = wb.Worksheets("passifM1") Set wsMCour100 = wb.Worksheets("passifM10") Else MsgBox "Veuillez clarifier votre choix, fin" Exit Sub End If wsMCour2.Rows(1).Copy wsMCour100.Range("A1") 'Range sort before array affect SortRange2 wsMPrec1 SortRange2 wsMCour2 RetRowNbFor wsMPrec1, wsMCour2, wsMCour100 wsMCour100.Select Call DisplayNewAgences With Application .Calculation = xlCalculationAutomatic .ScreenUpdating = True .DisplayAlerts = True End With Set wb = Nothing Set wsMPrec1 = Nothing Set wsMCour2 = Nothing Set wsMCour100 = Nothing End Sub Sub RetRowNbFor(ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet) Dim rM As Range Dim lastr1 As Long, lastr2 As Long Dim lastr3 As Long Dim lastc1 As Long, lastc2 As Long Dim lastr1b As Long, lastr2b As Long Dim i As Long, j As Long, k As Long Dim z As Long Dim boo As Long Dim Vjuin As Long, Vjuill As Long Dim VjuinB As Long, VjuillB As Long Dim Fjuill As Long Dim bplus As Long, bmoins As Long Dim r As Range boo = 0 lastr1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row lastc1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column lastr2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row lastc2 = ws2.Cells(1, Columns.Count).End(xlToLeft).Column k = 2 boo = 0 For i = lastr1 To 2 Step -1 boo = 0 If IsEmpty(ws1.Cells(i, 1).Value) = False Then Vjuin = ws1.Cells(i, 1).Value For j = lastr2 To 2 Step -1 If IsEmpty(ws2.Cells(j, 1).Value) = False Then Vjuill = ws2.Cells(j, 1).Value If Vjuill < Vjuin Then boo = 3 ElseIf Vjuill = Vjuin Then boo = 2 Exit For Else boo = 0 End If End If Next j If boo = 3 Then ws3.Cells(k, 1).Value = Vjuin ws3.Rows(k).Insert ElseIf boo = 2 Then Set rM = ws2.Range(ws2.Cells(j, 1), ws2.Cells(j, lastc2)) rM.Copy ws3.Cells(k, 1) ws3.Rows(k).Insert End If End If Next i For i = lastr2 To 2 Step -1 boo = 0 If IsEmpty(ws2.Cells(i, 1).Value) = False Then Vjuill = ws2.Cells(i, 1).Value For j = lastr1 To 2 Step -1 boo = 0 If IsEmpty(ws1.Cells(j, 1).Value) = False Then Vjuin = ws1.Cells(j, 1).Value If Vjuin < Vjuill Then boo = 1 Else Exit For End If End If Next j If boo = 1 Then lastr3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row For j = lastr3 To 2 Step -1 Fjuill = ws3.Cells(j, 1).Value If IsEmpty(ws3.Cells(j + 1, 1)) = False Then bplus = ws3.Cells(j + 1, 1).Value Else bplus = 999999 End If If j = 2 Then bmoins = 0 Else bmoins = ws3.Cells(j - 1, 1).Value End If If Vjuill < bplus And Vjuill bmoins Then Set rM = ws2.Range(ws2.Cells(i, 1), ws2.Cells(i, lastc2)) ws3.Rows(j).Insert rM.Copy ws3.Cells(j, 1) ws3.Cells(j, 2).Interior.Color = 65535 Exit For End If Next j End If End If Next i ws3.Rows(2).Delete End Sub Sub SortRange2(ws As Worksheet) Dim lastr As Long Dim lastc As Long lastr = ws.Cells(Rows.Count, 1).End(xlUp).Row lastc = ws.Cells(1, Columns.Count).End(xlToLeft).Column Dim r As Range Set r = ws.Range(ws.Cells(1, 1), ws.Cells(lastr, lastc)) r.Sort key1:=ws.Columns(1), Header:=xlYes End Sub Sub optActif() Dim wb As Workbook Dim ws As Worksheet Set wb = ThisWorkbook Set ws = wb.Worksheets("GLOBAL100") 'optionBleuVert = "Actif" ws.Cells(13, 9) = "actif" End Sub Sub optPassif() Dim wb As Workbook Dim ws As Worksheet Set wb = ThisWorkbook Set ws = wb.Worksheets("GLOBAL100") ws.Cells(13, 9) = "passif" End Sub Pascal Baro |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How do I align numbers in different cells when some are in bracke. | Excel Discussion (Misc queries) | |||
ALIGN DATA CELLS? | Excel Discussion (Misc queries) | |||
Align matching cells of two different columns | Excel Worksheet Functions | |||
how to align vertical cells horizontally | New Users to Excel | |||
How do I align cells in Excel onto one line? | Excel Worksheet Functions |