View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
bpascal123 bpascal123 is offline
external usenet poster
 
Posts: 5
Default Align cells with same value - vba almost working

Hi cyberspace,

I have spent quite some time trying to make this work but at this
point from adding many msgbox checks, using the watch window for
variables values everything seems coherent to me.

I have 2 columns with sorted identical and not identical numercial
values in both columns :

col.A col.B
251120 251130
251140 272505
251145 291101
272505 292100
272535
291130
292100

I need to align identical value and to place single value alone on
one
row just like below :

251120
251130
251140
251145
272505 272505
272535
291101
291130
292100 292100

Now with the vba code, I get this :

Option Explicit
Option Base 1

Public Sub RowMatching()

Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = Workbooks("code_row_v2.xls")
Set wks = wkb.Worksheets("Sheet1")
Dim trouve As Boolean
Dim LigCol1 As Integer 'numéro de ligne pour la premiere colonne
Dim LigCol2 As Integer 'numéro de ligne pour la seconde colonne
Dim LastRow As Long
Dim tmp
Dim Numligne(256) As Long
Dim marchehaute As Integer
Dim marchebasse As Integer
Dim marche As Integer

wks.Cells(1, 1).Select
LastRow = 0
LigCol1 = 1
While wks.Cells(LigCol1, 1) < ""
LastRow = LastRow + 1
LigCol1 = LigCol1 + 1
Wend
LigCol1 = 1
wks.Cells(LigCol1, 1).Select

While LigCol1 <= LastRow '''MAIN LOOP

Numligne(LigCol1) = wks.Cells(LigCol1, 1)
'MsgBox wks.Cells(LigCol1, 1)

For LigCol2 = 1 To LastRow
If Numligne(LigCol1) = wks.Cells(LigCol2, 2) Then '2a-IF7
If LigCol2 < LigCol1 Then '3a-IF9
Cells(LigCol2, 2).Select
marchehaute = LigCol1 - LigCol2
marche = 1
While marche <= marchehaute
Selection.Insert shift:=xlDown
marche = marche + 1
Wend
ElseIf LigCol2 LigCol1 Then
Cells(LigCol1, 1).Select
marchebasse = LigCol2 - LigCol1
marche = 1
While marche <= marchebasse
Selection.Insert shift:=xlDown
marche = marche + 1
LastRow = LastRow + 1
Wend
End If '3a-IF9
End If '2a-IF7
Next LigCol2
LigCol1 = LigCol1 + 1

Wend '''END MAIN LOOP

LigCol1 = 1
wks.Cells(LigCol1, 1).Select

''SECONDARY LOOP TO INSERT ROW FOR REMAINING NON IDENTICAL VALUES
FOUND ONTO SAME ROWS

For LigCol1 = 1 To LastRow '

MsgBox wks.Cells(LigCol1, 1) & " - " & wks.Cells(LigCol1, 2)
If Not IsEmpty(wks.Cells(LigCol1)) Then
If wks.Cells(LigCol1, 1).Value < wks.Cells(LigCol1, 2).Value
Then
Rows(LigCol1).Select
Selection.Insert shift:=xlDown
Cells(LigCol1 + 1, 1).Select
Selection.Cut
Cells(LigCol1, 1).Select
ActiveSheet.Paste
LastRow = LastRow + 1
End If
End If '2b-IF5

Next LigCol1 '''END SECONDARY LOOP

MsgBox LastRow

End Sub

Variable names are in french but it's easy : consider marche is
floor : marchebasse = lowerfloor, marchehaute = upperfloor... in fact
marche means step but steps has many meaning in english and is a vba
keyword as well..., here it would
be stairway.

Ok, this is what I get when i run the code from above :

251120
251130
251140
251145
272505 272505
272535 291101
291130
292100 292100

Although, the switch is completed for values 251120 and 251130
initialy on the same row, they are now on 2 distinct rows as stated
in For LigCol1 = 1 To LastRow loop .

But when it comes to values 272535 and 291101, no new rows is added
as
it should for two different values on the same row. msgbox even show
the loop is going though these values as with 251120 and 251130
Could you point where I am missing something?

I would very much appreciate to understand why it's not working as
intended as it seems coherent from the msgbox checks when running it.
I think something is messing in the secondary loop block code.

Thanks,
Cyberuser