VBA To Compare Multiple Cells

**x010** · 08-28-2013, 02:19 AM

Hi everyone,

I am new to VBA programming in Excel. Can someone please help me create a VBA program. I have searched in multiple websites but i couldn't find anything. I already made the program to compare 2 columns based of fixed rows and cells.

What i'm trying to do now is the following:

- The user will input the number of columns and select it's cell location
- Then the macro will compare the cell values of every columns at the same time, row by row. For example: Cell 1, Column 1 vs Cell 1, Column 2 and Cell 1, Column 1 vs Cell 1, Column 3 (if the number of selected columns is 3)
- If the compare fails the script will shift the row of the column where the compare failed down.

Here's what i made so far, the problem is the columns comparision is made only by 2 columns at a time. I've also attached my workbook.

13081715551.xlsm

Code:

Option Base 1
Sub userDef()
    Dim cNum As Long
    Dim stColArray(), lstColArray() As Variant
    Dim cRowArray(), cColArray() As Variant
    Dim cSel, rSel As Range
    Dim rw, col, j, mvSt1, mvEnd1, mvSt2, mvEnd2 As Integer

    j = 1
    
    cNum = Application.InputBox("Number of columns:")
    ReDim rStArray(cNum)
    ReDim stColArray(cNum)
    ReDim lstColArray(cNum)
    ReDim cRowArray(cNum)
    ReDim cColArray(cNum)
    For c = 1 To cNum
        Set rSel = Application.InputBox("Select " & c & " table(s)", Type:=8)
        Set cSel = Application.InputBox("Select " & c & " cell(s) of " & c & " table", Type:=8)
        If rSel Is Nothing Then
            MsgBox "No cell selected"
            Exit Sub
        Else
            stColArray(j) = rSel.Column
            lstColArray(j) = rSel.Columns(rSel.Columns.Count).Column
            cRowArray(j) = cSel.Row
            cColArray(j) = cSel.Column
            j = j + 1
        End If
    Next c
    
    
    j = 1
    x = 1
    y = 2
    rw = cRowArray(j)
    
nxtChk:
  
  a = Math.Round(Cells(rw, cColArray(x)).Value, 2)
  d = Math.Round(Cells(rw + 1, cColArray(x)).Value, 2)
  mvSt1 = stColArray(x)
  mvEnd1 = lstColArray(x)

  b = Math.Round(Cells(rw, cColArray(y)).Value, 2)
  c = Math.Round(Cells(rw + 1, cColArray(y)).Value, 2)
  mvSt2 = stColArray(y)
  mvEnd2 = lstColArray(y)
  
  stDevAB = Math.Sqr((((b - ((b + a) / 2)) ^ 2) + ((a - ((b + a) / 2)) ^ 2)) / 2)
  stDevAC = Math.Sqr((((c - ((c + a) / 2)) ^ 2) + ((a - ((c + a) / 2)) ^ 2)) / 2)
  stDevBA = Math.Sqr((((a - ((a + b) / 2)) ^ 2) + ((b - ((a + b) / 2)) ^ 2)) / 2)
  stDevBD = Math.Sqr((((d - ((d + b) / 2)) ^ 2) + ((d - ((d + b) / 2)) ^ 2)) / 2)
  stErrAB = stDevAB / Math.Sqr(2)
  stErrAC = stDevAC / Math.Sqr(2)
  stErrBA = stDevBA / Math.Sqr(2)
  stErrBD = stDevBD / Math.Sqr(2)
  
  If a > 0 And b > 0 Then
    chisqrAB = ((b - a) - 0.05) ^ 2 / a
    p_val_AB = WorksheetFunction.ChiDist(chisqrAB, 1)
    chisqrAC = ((c - a) - 0.05) ^ 2 / a
    p_val_AC = WorksheetFunction.ChiDist(chisqrAC, 1)
    chisqrBA = ((a - b) - 0.05) ^ 2 / b
    p_val_BA = WorksheetFunction.ChiDist(chisqrBA, 1)
    chisqrBD = ((d - b) - 0.05) ^ 2 / b
    p_val_BD = WorksheetFunction.ChiDist(chisqrBD, 1)
  End If
 
  If a > 0 And stDevAB > stDevAC And stErrAB > stErrAC And p_val_AB < p_val_AC Then
        For col = mvSt1 To mvEnd1
        Cells(rw, col).Insert shift:=xlDown
        Next col
  ElseIf b > 0 And stDevBA > stDevBD And stErrBA > stErrBD And p_val_BA < p_val_BD Then
        For col = mvSt2 To mvEnd2
        Cells(rw, col).Insert shift:=xlDown
        Next col
  End If


    If rw > 5 And b = 0 Then
    y = y + 1
    rw = cRowArray(j) - 1
    End If
    If rw > 5 And b = 0 And y > cNum Then Exit Sub
    rw = rw + 1

GoTo nxtChk
    
End Sub

I'm stuck at this point.

**Excel Fox** · 08-29-2013, 10:22 PM

x010, I see three separate sets of data in your worksheet. Can you show exactly what you are trying to do?

**x010** · 08-30-2013, 05:14 PM

**Excel Fox** · 08-30-2013, 07:35 PM

Still not very clear. Can you post a sample workbook with the original input, and the expected output after the macro is run? And then explain what was the intended logic. Probably that should make it clear.

**x010** · 08-31-2013, 01:53 AM

If you take the my first uploaded workbook as my first input, here's what the output workbook should look like: 13081715551-out.xlsb

I've trimmed it down because there were too much values to correct manually.

Hope this helps.