quick fix in the function... base 0 - base 1 arrays confusion fixed.
however, the last row comes with garbage data #NA why so?
Function CopyFirstCol(rg As Range, wsB As Worksheet, NEMP As Long)
'
'This function both copies pastes columns 1 and return an array with merged
cells row numbers
'
Dim c As Range
Dim MCellV() 'Array to store merged cells values
Dim MCellA() 'Array to store merged cells addresses or row numbers
Dim Firm() 'Array to store col 1
Dim Activity() 'Array to store col 2
Dim No() 'Array to store col 4
Dim Capacity() 'Array to store col 5
Dim Rating() 'Array to store col 6
Dim i As Long, j As Long
Dim N As Long
i = 0
ReDim MCellV(i)
ReDim MCellA(i)
j = 0
ReDim Firm(j)
ReDim Activity(j)
ReDim No(j)
ReDim Capacity(j)
ReDim Rating(j)
For Each c In rg
If c.MergeCells Then
MCellV(i) = c.Value
MCellA(i) = c.Row - 9
i = i + 1
ReDim Preserve MCellV(i)
ReDim Preserve MCellA(i)
Else
Firm(j) = c.Value
Activity(j) = c.Offset(, 1).Value
No(j) = c.Offset(, 2).Value
If c.Offset(, 2).Value = vbNullString Then No(j) = "NA"
Capacity(j) = c.Offset(, 3).Value
If c.Offset(, 3).Value = vbNullString Then Capacity(j) = "NA"
Rating(j) = c.Offset(, 4).Value
If c.Offset(, 4).Value = vbNullString Then Rating(j) = "NA"
j = j + 1
ReDim Preserve Firm(j)
ReDim Preserve Activity(j)
ReDim Preserve No(j)
ReDim Preserve Capacity(j)
ReDim Preserve Rating(j)
End If
Next c
N = j
ReDim Preserve MCellV(i - 1)
ReDim Preserve MCellA(i - 1)
ReDim Preserve Firm(j - 1)
ReDim Preserve Activity(j - 1)
ReDim Preserve No(j - 1)
ReDim Preserve Capacity(j - 1)
ReDim Preserve Rating(j - 1)
'This copies the data from the firm x the number of employees
j = 2
For i = 1 To NEMP
wsB.Range(wsB.Cells(j, 1), wsB.Cells(j + N, 1)).Value = _
WorksheetFunction.Transpose(Firm)
wsB.Range(wsB.Cells(j, 3), wsB.Cells(j + N, 3)).Value = _
WorksheetFunction.Transpose(Activity)
wsB.Range(wsB.Cells(j, 4), wsB.Cells(j + N, 4)).Value = _
WorksheetFunction.Transpose(No)
wsB.Range(wsB.Cells(j, 5), wsB.Cells(j + N, 5)).Value = _
WorksheetFunction.Transpose(Capacity)
wsB.Range(wsB.Cells(j, 6), wsB.Cells(j + N, 6)).Value = _
WorksheetFunction.Transpose(Rating)
j = j + N
Next i
CopyFirstCol = MCellA
End Function
---
Pascal Baro
bpascal...@gmail.com
--
--
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
