Hello Pascal,
Your code does not pick up the General Category Activity from Row 911 in
Original Sheet.
Please look into this.
Thanks for your effort
On Wednesday, July 25, 2012 11:42:41 PM UTC+4, bpascal123 wrote:
> Hi Anil,
>
> I have started looking at your query. I'm getting somewhere with the code
> below but if someone in this forum can me figure out why these lines are
> not getting all values:
>
> 'This loop stores the number of times an activity occurs between 2 merged
> cells --> need assistance,,, not accurate
> ReDim actNb(0)
> i = 0: j = 0
> For Each c In r
> If Not c.MergeCells Then
> j = j + 1
> Else
> actNb(i) = j
> i = i + 1
> ReDim Preserve actNb(i)
> j = 0
> End If
> Next
> The code I have worked out is below. If someone can help, it would speed
> things up otherwise I'll take another look this week-end if I can.
>
> Sub ModuleA()
>
> 'wor is original data wou is output sheet
> Dim wor As Worksheet, wou As Worksheet
> Set wor = ThisWorkbook.Worksheets("Original")
> Set wou = ThisWorkbook.Worksheets("Output")
>
> With Application
> .Calculation = xlCalculationManual
> .ScreenUpdating = False
> .DisplayAlerts = False
> End With
>
> Dim r As Range
> Dim c As Range
> 'hdr is an array to copy the first header
> 'emp is an array to store employee names
> 'act is an array to store the data related to the merged cells you label
> as activity
> 'actNb is an array that should store the number of times of an activity
> for each "firm"
> Dim hdr(), emp(), firm(), act(), actNb()
> Dim lastr As Long, lastc As Long
> Dim empNb As Long
> Dim i As Long, j As Long, k As Long
>
> 'formatting stuff...
> wou.Cells.Delete
> hdr = Array("Firm", "Activity", "Subtask", "No", "Capacity", "Modified
> Risk Rating", "Name", "Hours", "EOM")
> wou.Range("A1:i1") = hdr
> wou.Range("A1:i1").Font.Bold = True
> wou.Range("A1:I1").Interior.Color = 65535
> lastc = wor.Cells(4, Columns.Count).End(xlToLeft).Column
> emp = wor.Range(wor.Cells(4, 6), wor.Cells(4, lastc))
> empNb = UBound(emp, 2)
>
> ReDim act(0)
> ReDim firm(0)
> lastr = wor.Cells(Rows.Count, 1).End(xlUp).Row
> 'r stores the first column
> Set r = wor.Range(wor.Cells(10, 1), wor.Cells(lastr, 1))
>
> 'this loop stores data in 2 arrays: act for merged cells values and firm
> for Firm cell values
> i = 0: j = 0
> For Each c In r
> If c.MergeCells Then
> act(i) = c.Value
> i = i + 1
> ReDim Preserve act(i)
> Else
> firm(j) = c.Value
> j = j + 1
> ReDim Preserve firm(j)
> End If
> Next
>
> i = i - 1
> ReDim Preserve act(i)
> j = j - 1
> ReDim Preserve firm(j)
>
> 'This loop stores the number of times an activity occurs between 2 merged
> cells --> need assistance,,, not accurate
> ReDim actNb(0)
> i = 0: j = 0
> For Each c In r
> If Not c.MergeCells Then
> j = j + 1
> Else
> actNb(i) = j
> i = i + 1
> ReDim Preserve actNb(i)
> j = 0
> End If
> Next
>
> 'This copies the data from the firm x the number of employees
> j = 2
> For i = 0 To UBound(emp, 2)
> wou.Range(wou.Cells(j, 1), wou.Cells(j + UBound(firm, 1), 1)).Value = _
> WorksheetFunction.Transpose(firm)
> j = j + UBound(firm, 1)
> Next i
>
> 'This copies the data from the activity labelled in the merged cells, it
> should work if actNb was ok
> k = 0
> For i = 0 To UBound(emp, 2)
> For j = 0 To UBound(act, 1)
> wou.Range(wou.Cells(k + 2, 2), wou.Cells(actNb(j + 1) + 2 + k,
> 2)).Value = act(j)
> k = k + actNb(j + 1)
> Next j
> Next i
>
> With Application
> .Calculation = xlCalculationAutomatic
> .ScreenUpdating = True
> .DisplayAlerts = True
> End With
>
> End Sub
>
>
> So should someone help me fix the wrongdoing loop, this code will first
> work with the first 2 columns.
>
> As I said earlier, if you could manage to have your data re-arranged and
> sorted in another way, because I really see this as the job of a pivot
> table. More, at my vba level coding this with this code will require a few
> more consistent loops. If your original data ever changes, a lot will have
> to changed as well.
>
> I'll be happy if I can get you with a final result but it will take some
> more times unless someone comes with a fix or an easier solution.
>
> 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
