Oops I sent the code from the wrong module. I coded this just to fill one
column accross two worksheets within the same workbook. Actually, the
following line fill in column B.
'Set ra = wsa.Range(wsa.Cells(1, 2), wsa.Cells(Rows.Count, 2))
Set rb = wsb.Range(wsb.Cells(1, 2), wsb.Cells(1000, 2))
When changed to this
'Set ra = wsa.Range(wsa.Cells(1, 1), wsa.Cells(Rows.Count, 1))
Set rb = wsb.Range(wsb.Cells(1,1), wsb.Cells(1000, 1))
it will fill column A.
Now the code I have troubled with:
----
Sub twocols()
Dim wsa As Worksheet, wsb As Worksheet
Dim d As Object
Dim a(), b(), c()
Dim aa(), bb(), aaa(), bbb()
Dim ma As Long, mb As Long
Dim na As Long, nb As Long
Dim e As Variant
Dim p As Long, q As Long
Dim r As Long, m As Long
Dim i As Long, ii As Long
With Application
.Calculation = xlCalculationManual
.DisplayAlerts = False
.ScreenUpdating = False
End With
Set wsa = ThisWorkbook.Worksheets("MSH1")
Set wsb = ThisWorkbook.Worksheets("MSH2")
Set d = CreateObject("scripting.dictionary")
With wsa
If .Cells(.Rows.Count, 1) <> vbNullString Then
ma = .Rows.Count
Else
ma = .Range("A" & .Rows.Count).End(xlUp).Row
End If
a = .Range("A2:A" & ma)
If .Cells(Rows.Count, 2) <> vbNullString Then
mb = .Rows.Count
Else
mb = .Range("B" & .Rows.Count).End(xlUp).Row
End If
b = .Range("B2:B" & mb)
End With
With wsb
If .Cells(.Rows.Count, 1) <> vbNullString Then
na = .Rows.Count
Else
na = .Range("A" & .Rows.Count).End(xlUp).Row
End If
aa = .Range("A2:A" & na)
If .Cells(Rows.Count, 2) <> vbNullString Then
nb = .Rows.Count
Else
nb = .Range("B" & .Rows.Count).End(xlUp).Row
End If
bb = .Range("B2:B" & nb)
End With
ReDim aaa(1 To UBound(a) + UBound(aa))
ReDim bbb(1 To UBound(b) + UBound(bb))
ReDim c(1 To Application.Max(ma, mb), 1 To 3)
For i = 1 To UBound(a)
aaa(i) = a(i, 1)
Next i
ii = i
For i = 1 To UBound(aa)
aaa(ii) = aa(i, 1)
ii = ii + 1
Next i
For Each e In a
d(e) = 1
Next
For Each e In b
If d(e) = 1 Then
r = r + 1
c(r, 3) = e
Else
q = q + 1
c(q, 2) = e
End If
Next
d.RemoveAll
For Each e In b
d(e) = 1
Next
For Each e In a
If d(e) <> 1 Then
p = p + 1
c(p, 1) = e
End If
Next
m = Application.Max(p, q, r)
Range("C2").Resize(m, 3) = c
With Application
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
---
Thanks Paul if you can also look at this message.
Pascal Baro
--
FORUM RULES (986+ members already BANNED for violation)
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Cross-promotion of, or links to, forums competitive to this forum in
signatures are prohibited.
NOTE : Don't ever post personal or confidential data in a workbook. Forum
owners and members are not responsible for any loss.
------------------------------------------------------------------------------------------------------
To post to this group, send email to excel-macros@googlegroups.com
To unsubscribe, send a blank email to excel-macros+unsubscr...@googlegroups.com
