PDA

View Full Version : Relist Column



akamax_power
06-29-2009, 03:46 PM
I have 2 columns. Column A is the working column, sometimes there are values entered and sometimes they're empty. I want to relist Column A in Column B as is updated but without the empty cells inbetween.



Thanks

lw22
06-29-2009, 05:08 PM
I'm no expert but it works for me if thats what you are looking for.

Sub MoveAtoB()
Dim LastRow As Long, RowB As Long, i As Long
LastRow = Range("A65536").End(xlUp).Row

RowB = 1

For i = 1 To LastRow
If Cells(i, 1).Value <> "" Then
Cells(RowB, 2).Value = "=A" & CStr(i)
'If you don't want the ColumnB to dynamically change with column A replace the above code with the code below
'Cells(RowB, 2).Value = Cells(i, 1).Value
RowB = RowB + 1
End If
Next i
End Sub

akamax_power
06-30-2009, 08:41 AM
Thanks, this works. I should have mentioned this but records can also be cleared in column A. With this code when it updates it leaves duplicates in column B. I guess I could just run a clearcontents for column B before the loop runs. Any suggestions?

lw22
06-30-2009, 03:48 PM
If I understand you correctly you only want 1 occurrence of a value in column in column b? This may not be the best approach but it may work. If it isn't what you are looking for explain a little more of what you want and maybe add a sample file. - second thought thats not completely working the way you want it to. I'll look at it later.


Sub MoveAtoB()
Dim LastRowA As Long, RowB As Long, i As Long
LastRow = Range("A65536").End(xlUp).Row

If Cells(1, 2).Value = "" Then
RowB = 1
Else
RowB = Range("B65536").End(xlUp).Row + 1
End If

For i = 1 To LastRow
If Cells(i, 1).Value <> "" Then
If Range("B:B").Find(Cells(i, 1).Value) Is Nothing Then
Cells(RowB, 2).Value = "=A" & CStr(i)
'If you don't want the ColumnB to dynamically change with column A replace the above code with the code below
'Cells(RowB, 2).Value = Cells(i, 1).Value
RowB = RowB + 1
End If
End If
Next i
End Sub

akamax_power
06-30-2009, 04:22 PM
Sorry about this, I've attached a file to try and explain what I'm talking about. In the file there are 3 examples: Working Columns, Example 1, and Example 2. The initial code you posted works so the data in colulmn A is relisted in Column B. So you can go from the Working Column ex. to the Example 1 ex with no problem. But when you go from the Example 1 to Example 2 you get extra values left behind when it relists column A. The final example shows what I'm trying to achieve. Again, thanks for your time.

mdmackillop
07-01-2009, 05:47 AM
But when you go from the Example 1 to Example 2 you get extra values left behind when it relists column A.
I've read this a couple of times but am still confused. What is "relisting column A", "left behind"?

Have a look at Advanced Filter if you simply want to copy unique values to a new location.

akamax_power
07-01-2009, 08:56 AM
Again sorry, I guess I'm having a hard time trying to explain what I'm trying to accomplish but I think I might have figured out a solution. First off I've triggered the above macro everytime a change is made in column A (Reading my other posts I don't think I mentioned this). So using the "Working Columns" list if you enter '32' in cell A13 and '45' in cell A15 the ending result is what is displayed in "Example 1", which is part of what I want. Now if one at a time you clear cells A6, A11, and A12 the ending result is whats displayed in "Example 2". Cells A11:A13 are left with "=A18" because each time a change is made it runs through the loop. So here's what I've come up with to try and fix that so the end result is what's displayed in the "What I'm Looking For" :Sub MoveAtoB()
Dim LastRow As Long, RowB As Long, i As Long
LastRow = Range("A65536").End(xlUp).Row

RowB = 3
Sheet1.Range("B3:B65536").ClearContents '<--Section I've added-->
For i = 3 To LastRow
If Cells(i, 1).Value <> "" Then
Cells(RowB, 2).Value = "=A" & CStr(i)
'If you don't want the ColumnB to dynamically change with column A replace the above code with the code below
'Cells(RowB, 2).Value = Cells(i, 1).Value
RowB = RowB + 1
End If
Next i
End Sub


I don't know if it's the best way

Thanks

mdmackillop
07-01-2009, 09:58 AM
Try

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Columns(2).ClearContents
Range("A2:A2000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"B2"), Unique:=True
End If
End Sub