how to loop in vba

[babunchakr]

I have two sheets: one is input and the other is master.

A snapshot of my input sheet is shown below:

ID WEEK BILL_LAB_HRS
a11 w1 40
a11 w2 60
a22 w5 30
a22 w8 20
a33 w9 10
a44 w10 80.....so on

week is in column 31, BILL_LAB_HRS in 32 and ID is column 37

my result sheet should look like this
A snapshot of my master sheet is shown below (NB: the ID are unique)

ID W1 W2 W3 W4 W5 W6 W7 W8 W9 W10
a11 40 60
a22 30 20
a33 10
a44 80




I want a loop so that it can give result for BILL_LAB_HRS against each ID in my masters table in their respective weeks(w1 to w13)


Any suggestions how to loop it in VBA

Please help....

[mancubus]

i would use a pivot table.

row labels : ID
column labels: WEEK
values: sum of BILL_LAB_HRS

[babunchakr]

yes very true but i need this for 13 weeks and pivot cant give all weeks mapping

[mancubus]

i think i dont understand the problem.

see the attached file...

pivot table here contains 48 unique week numbers...

[babunchakr]

plz see the attached file


my input sheet dont have some weeks e.g w3 and w4 is missing

bu in my master sheet i want all the week names which a pivot cant give...


thnx

[mancubus]

i would add missing week numbers just after my table. 1 row for each missing week.

[mancubus]

i dont have much time these days.

i can work on a macro solution later, if not solved already.

[mancubus]

as promised before, here it is...

again, i would use a pivot table

[VBA]
Sub Manual_Pivot_Sumifs()

Dim wsInp As Worksheet, wsMas As Worksheet
Dim tmpArr, e, arrId, arrWeek
Dim i As Long, calc As Long
Dim startWeek As Byte, endWeek As Byte, numWeek As Byte, b As Byte

Set wsInp = Worksheets("Input")
Set wsMas = Worksheets("Master")

With wsInp
tmpArr = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
End With

With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare 'case insensitive
For Each e In tmpArr
If Not IsEmpty(e) And Not .Exists(e) Then .Add e, Nothing
Next
arrId = .Keys
End With

startWeek = 1 'change to actual number of start week
endWeek = 25 'change to actual number of end week
numWeek = endWeek - startWeek + 1
ReDim arrWeek(1 To endWeek)
For b = 1 To numWeek
arrWeek(b) = "w" & Format(b, "00")
Next

calc = Application.Calculation
Application.Calculation = xlCalculationAutomatic
With wsMas
.Cells.Clear 'clear existing values, if any...
.Range("A2").Resize(UBound(arrId) + 1).Value = Application.Transpose(arrId)
.Range("B1").Resize(, UBound(arrWeek)) = arrWeek
With .Range("B2").Resize(UBound(arrId) + 1, UBound(arrWeek))
.FormulaR1C1 = "=SUMIFS(Input!C3,Input!C1,RC1,Input!C2,R1C)"
.Value = .Value
End With
End With
Application.Calculation = calc

End Sub

[/VBA]