Column matchSolved/Closed

Question

Hello, 

I have two columns in excel 2007.  Both columns show menu items from another computer system.  So, as an example different roles in our company are given different menu access rights to the system.  Some roles in the company require 2 or 3 menu access rights.  As the system is written in an older language it is not that flexible in reporting.  When you ask for the system to tell you what rights each menu has it does a raw dump and when you review the access rights it makes it difficult to align or reconcile.

So what I might have is something like this

Column A     Column B
men 890      men 890
  submen a  men 891
  submen b  men 892
men 891           submen 120
  submen x   men 135
men 892      men 136
men 135      men 137A
Men 137A

etc,


What I was eeking was a formula that looks at both columns and determines if they match and if not such Row 3 it would force column b to "move down to row 5 where it would match.  
Is this possible

Configuration: Windows XP / Internet Explorer 8.0

rizvisa1 · Answer

Can this data be sorted ?

rizvisa1 · Answer

try this. there is a function and a sub. You need to run sub MultiLevelAlign

Sub MultiLevelAlign()

Dim lMaxRowsL As Long
Dim lMaxRowsR As Long
Dim sBCol As String
Dim sJCol As String
Dim vSpaceL As String
Dim vSpaceR As String
Dim valueL As String
Dim valueR As String

    sBCol = "B"
    sJCol = "J"
    
    lMaxRowsL = Cells(Rows.Count, "A").End(xlUp).Row
    lMaxRowsR = Cells(Rows.Count, "I").End(xlUp).Row
    
    With Range(sBCol & "2:" & sBCol & lMaxRowsL)
        .FormulaR1C1 = "=LEN(RC1)-LEN(myTrim(RC1,""L""))"
        .Copy
        .PasteSpecial xlPasteValues
    End With
    
    With Range(sJCol & "2:" & sJCol & lMaxRowsR)
        .FormulaR1C1 = "=LEN(RC9)-LEN(myTrim(RC9,""L""))"
        .Copy
        .PasteSpecial xlPasteValues
    End With
    
    lMaxRowsL = 2
   
    Do While (lMaxRowsL <= lMaxRowsR)

        valueL = Cells(lMaxRowsL, "A")
        valueR = Cells(lMaxRowsL, "I")
        
        vSpaceL = Cells(lMaxRowsL, sBCol)
        vSpaceR = Cells(lMaxRowsL, sJCol)
        
        
        If (vSpaceL = vSpaceR) Then
        
            If valueL > valueR Then
                Range("I" & lMaxRowsL & ":" & sJCol & lMaxRowsL).Insert Shift:=xlDown
                lMaxRowsR = lMaxRowsR + 1
                
            ElseIf valueL < valueR Then
            
                Range("A" & lMaxRowsL & ":" & sBCol & lMaxRowsL).Insert Shift:=xlDown
                
            
            Else
            
            End If
        
        ElseIf (vSpaceL > vSpaceR) Then
        
            Range("I" & lMaxRowsL & ":" & sJCol & lMaxRowsL).Insert Shift:=xlDown
            lMaxRowsR = lMaxRowsR + 1
            
        ElseIf (vSpaceL < vSpaceR) Then
        
            Range("A" & lMaxRowsL & ":" & sBCol & lMaxRowsL).Insert Shift:=xlDown
        
        End If
        
        lMaxRowsL = lMaxRowsL + 1
    Loop
    
    Range(sBCol & ":" & sBCol).Clear
    Range(sJCol & ":" & sJCol).Clear
    
    
End Sub


Function myTrim(myString, Optional trimType As String = "") As String

    Select Case UCase(trimType)
    
        Case Is = "L"
            
            myTrim = LTrim(myString)
            
        Case Is = "R"
            myTrim = RTrim(myString)
            
        Case Is = ""
            myTrim = Trim(myString)
        Case Else
            myTrim = "#NAME?"
        End Select
End Function

Column match

2 responses

Similar discussions

Subscribe To Our Newsletter!