Looping through 2 WB and paste values

[Hawjeen]

Hi All,

I have to perform a task af mainting a list of articles and som data releated to it.

what i need is an output that looks like this
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Article number[/TD]
[TD]article text
[/TD]
[TD]avg. factor
[/TD]
[TD]1st occ
[/TD]
[TD]2nd occ
[/TD]
[TD]3th occ
[/TD]
[TD]4th occ
[/TD]
[TD]5th occ
[/TD]
[TD]6th
[/TD]
[TD]7th
[/TD]
[TD]8th
[/TD]
[TD]9th
[/TD]
[TD]10th
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I have to loop thorugh 2 different WB to be able to do this

in A2 and B2 i have to go through all sheets in WB1 and if there is a value in column "C" it should copy the values in "C" and "D" and insert them into the acwb.
in C2 i need it to loop through WB2 in and sum all values in column "AC" and divide it with "Y" (sumif(D:D,A2,AC:AC)/sumif(D:D,A2,Y:Y))
in D2 and nth2 i need it to find every occurence of A2 in WB2 and do: = "sheetname"&" "&(AC/Y)

i know this is is very specific, but i hope someone could help me with this task

best regards
Hawjeen

 

[Hawjeen]

Hi again,

I started on my own, but maybe someone could help me a bit.

so far i have this:

---

Sub Art_liste()

Dim ws As Worksheet
Dim wb1 As Workbook
Dim wb2 As Workbook

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open(Filename:="Q:\ek-00_Faellesmappe_ZE\ARTIKELMELDING\varegruppeoversigt.xlsm", UpdateLinks:=False, ReadOnly:=True)

lr = Cells(Rows.Count, 3).End(xlUp).Row

For Each ws In wb2.Sheets
For i = 2 To lr
If Cells(i, 3) > 0 Then
Range(Cells(i, 3), Cells(i, 4)).Copy
wb1.Activate
Range("a1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
wb2.Activate
End If
Next i
Next ws
End Sub

---

the loop seems to work, it copies the cells from each line, but instead of changing sheets at the last row, it just repeats the same sheets.
i have never tried to loop before and cant understand what i need to change for it to work.

another thing is that i dont think think this is the smartest way to do it.
My need is to extract approxiametly 2000 lines over 60 sheets.
Maybe someone has a better idea on how to do it?

regards
Hawjeen

 

[Joe4]

the loop seems to work, it copies the cells from each line, but instead of changing sheets at the last row, it just repeats the same sheets.

Looping through the sheets does NOT actually activate or select them. All you are really doing there is flipping through a list of names.
You need to do something with that, either include the sheet reference in all range references below, or activate the sheets.
Otherwise, all your generic range references (like Cells(i,3) or Range("A1")) will keep referring to the Active sheet.

So it needs to look something like this:

[COLOR=#333333]For Each ws In wb2.Sheets[/COLOR]
[COLOR=#333333]    For i = 2 To lr[/COLOR]
[COLOR=#333333]        If [/COLOR][COLOR=#ff0000][B]ws.[/B][/COLOR][COLOR=#333333]Cells(i, 3) > 0 Then[/COLOR]

or this:

[COLOR=#333333]For Each ws In wb2.Sheets
[/COLOR][B][COLOR=#ff0000]    ws.Activate[/COLOR][/B]
[COLOR=#333333]    For i = 2 To lr[/COLOR]
[COLOR=#333333]        If [/COLOR][COLOR=#333333]Cells(i, 3) > 0 Then[/COLOR]

It is usually recommend to qualify all range references to include the sheet reference (like in my first example).
Then there is no confusion or ambiguity regardless which sheet that range is on.

 

[Hawjeen]

that helped, thank you!

Will you recomend this approach of mine?

 

[Joe4]

I cannot say that I fully follow the structure of all your sheets and exactly what it is that you are trying to do.
But if it appears to be doing what you want, then I would recommend trying to continue with it.

One thing I will recommend, especially when dealing with loops to help ensure your VBA code does not "bog down", add these two lines at the beginning of your code:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

This will temporarily suspend automatic calculations and screen updating when your code is running (these things can really slow code down!)

Then turn them back on at the end like this:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

 

[Hawjeen]

the last advise just cut down the running time from 5 minutes to 30 second, i really appriciate your advise.

i think i have to do normal formulas for the next parts it simply above my skill level.

but at least i learned somthing about loops today.

regards