Merge two tables into one - VBA help?

[Jovannivk]

Hi all, so I'm working on a project where I just cannot figure out what code to use in VBA.

I've got two data sources, namely my properties and a table of accounts I need to use for that.

Firstly, my properties will be shown below each other, for example:
d5nl0001
d5nl0002
d5nl0003

Secondly, for each property I need specific accounts (and for each property the same), for example:
Theoretical Rental Income
Corrective Maintenance
Systematic Maintenance
etc.

What I need is another range created that shows all the accounts for property one, then again for property two, etc., for example:
d5nl0001 theoretical rental income
d5nl0001 corrective maintenance
d5nl0001 systematic maintenance
d5nl0001 etc.
d5nl0002 theoretical rental income
d5nl0002 corrective maintenance
d5nl0002 systematic maintenance
d5nl0002 etc.
d5nl0003 theoretical rental income
d5nl0003 corrective maintenance
d5nl0003 systematic maintenance
d5nl0003 etc.

Let's say I have about 100 properties (where the amount of properties vary from time to time), and need these statements below each other. I'd need a macro for that. I have absolutely no idea how I should model this or write code for this one.

I'm open to any idea.

Thank you in advance.

Best,
Jovanni

[georgiboy]

Hi Jovannivk,

Welcome to the forum.

Take a look at the attached - it should help you out - code also below.

Sub test()
Dim pVar As Variant, aVar As Variant, x As Long, y As Long, z As Long
Dim rVar() As String

pVar = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
aVar = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).Value

For x = 1 To UBound(pVar)
For z = 1 To UBound(aVar)
ReDim Preserve rVar(y): rVar(y) = pVar(x, 1) & " " & aVar(z, 1): y = y + 1
Next z
Next x
Range("D2").Resize(UBound(rVar) + 1, 1) = Application.Transpose(rVar)
End Sub

Hope this helps

[JKwan]

Sub Generate()
k = 1
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
For j = 1 To Range("B" & Rows.Count).End(xlUp).Row
Cells(k, "D") = Cells(i, "A")
Cells(k, "E") = Cells(j, "B")
k = k + 1
Next j
Next i
End Sub

[Jovannivk]

Absolutely genius. Thank you both, georgiboy and JKwan.

I've tried it out and it works indeed. I will only need them in two seperate columns. Now I didn't manage to get them apart myself, I can change them text to columns but I don't think that's the most efficient way. Any chance you can make a small adjustment to get one column for the properties and one for the accounts..?
Also, out of curiosity, it seems to be that georgiboy's way is much more faster than JKwan. Could you explain to me how this is possible while still using the same data? Perhaps I could incorporate this into other macro's as well.

Thanks a lot anyway guys, you both deserve some lunch time .. :thumb

[snb]

Sub M_snb()
sn = columns(1).specialcells(2)
sp = columns(2).specialcells(2)
redim sq(ubound(sn) * ubound(sp),1)

for j = 1 to ubound(sn)
for jj = 1 to ubound(sp)
sq(n,0) = sn(j,1)
sq(n,1) = sp(jj,1)
n = n + 1
next
next

cells(1,4).resize(ubound(sq)+1,2) = sq
End Sub

[georgiboy]

Updated for 2 columns, the reason my and snb's code will run faster is due to working in memory and not interacting with the spreadsheet while inside the loops. Imagine the pVar, aVar and rVar (sn, sp & sq in snb's) are spreadsheet ranges but held in memory so you can't see them, we are looping through these ranges in memory and extracting information and transfering into a new range held in memory.

My (memory ranges, arrays) Variants are named:
pVar = Property Variant
aVar = Account Variant
rVar = Result Variant

The line at the end:

Range("D2").Resize(UBound(rVar) + 1, 2) = rVar
Resizes the range 'D2' to be the same size as 'rVar' and then drops the data held in rVar into that range.

Updated code below:

Sub test()
Dim pVar As Variant, aVar As Variant, rVar As Variant
Dim p As Long, a As Long, r As Long

pVar = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
aVar = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).Value
ReDim rVar(UBound(pVar) * UBound(aVar), 1)

For p = 1 To UBound(pVar)
For a = 1 To UBound(aVar)
rVar(r, 0) = pVar(p, 1): rVar(r, 1) = aVar(a, 1): r = r + 1
Next a
Next p
Range("D2").Resize(UBound(rVar) + 1, 2) = rVar
End Sub

Sorry I am not the best at explanations, hope this helps.

[snb]

@Geor

I managed.

A simpler alternative:


Sub M_snb()
sn = Columns(1).SpecialCells(2)
sp = Columns(2).SpecialCells(2)
ReDim sq(UBound(sn) * UBound(sp), 1)

For j = 0 To UBound(sq) - 1
sq(j, 0) = sn(j \ UBound(sp) + 1, 1)
sq(j, 1) = sp(j Mod UBound(sp) + 1, 1)
Next

Cells(1, 4).Resize(UBound(sq) + 1, 2) = sq
End Sub

[georgiboy]

@snb I see - it looks good - does it take the headers into account?

Looks like sn & sp could do with some offset resize action.

[snb]

In the - not posted - example of the TS no headers are present.
If there are, only +1 should adjusted to +2 in the loop

[georgiboy]

Yes, but it looks as if (looking at your choice of ranges) you have modelled your code on the mock-up of data that I produced as the OP did not specify the location of the lists nor the output.

[snb]

The TS doesn't mention any headers, not in text nor in the examples.

[georgiboy]

That is correct - wasn't the point I was making though.