Copying record value from column in multiple sheets into single sh

[Harish Sharma]

Hi,

I have some employee Records in sheets "Nov07","Dec07" and "Jan08".
the first two columns(A and B) are employee number and name in each sheet,
and column C is their overtime.

I want to create a consolidated sheet "YTD" so that I can see all their YTD
overtime in one sheet and do some analysis.

Hence the new sheet will have first two columns A and B same as above howver
column C, D and E will be the overtime from each sheet. It would have been a
simple copy paste if the number of employee had been static, but it changes
every months as new employee joins in or some leaves. Hence the macro needs
to validate employee number before copying the value from source sheet to
destination sheet

I have tried my best to create a Macro to do the same as below:

Dim Rno As Integer
Dim Svalue, OValue As String

Sub CopyCol()
For Each Tmprange In Worksheets("YTD").Range("b2:b117")
For Rno = 2 To 117
Svalue = "B" & Trim(Str(Rno)) 'cell reference of employee name from
Master "YTD" sheet
OValue = "C" & Trim(Str(Rno)) 'cell containing overtime of employee in
each sheet
If Trim(Tmprange.Value) = Trim(Worksheets("Oct07").Range(Svalue)) Then
Worksheets("YTD").Cells(Tmprange.Row, Tmprange.Column + 1).Value
= Trim(Worksheets("Oct07").Range(OValue))
End If
If Trim(Tmprange.Value) = Trim(Worksheets("Nov07").Range(Svalue)) Then
Worksheets("YTD").Cells(Tmprange.Row, Tmprange.Column + 2).Value
= Trim(Worksheets("Nov07").Range(OValue))
End If
If Trim(Tmprange.Value) = Trim(Worksheets("Dec07").Range(Svalue)) Then
Worksheets("YTD").Cells(Tmprange.Row, Tmprange.Column + 3).Value
= Trim(Worksheets("Nov07").Range(OValue))
End If
If Trim(Tmprange.Value) = Trim(Worksheets("Jan08").Range(Svalue)) Then
Worksheets("YTD").Cells(Tmprange.Row, Tmprange.Column + 4).Value
= Trim(Worksheets("Jan08").Range(OValue))
End If
Next Rno
Next
End sub

I know that this code looks non-generic and naive(I have a very basic
knowledge of VBA);

The problem you will see is that I will have to add a new statement every
time a new sheet is created.

Is there a better and efficient method or solution for this problem?

 

[OssieMac]

There are a couple of ways to do this depending on the setup of your workbook.

Are there any other worksheets other than YTD and ones named by month and
year?

Where is the tab position of YTD worksheet in relation to the others? Is it
at the left of the other worksheets? (Or can you put it there?)

Are the other worksheets named by month and year in order from the left and
can you keep them that way and always insert new sheets to the right.

 

[OssieMac]

The following is how you could do it if the workbook is set up with YTD as
first sheet and the others in order to the right of it.

It is untested so ensure that you have a backup of your workbook before
trying it.

'Assumes that the first worksheet is "YTD"
'so starts at worksheet 2

'Because start of For/Next is 2, you need to adjust the value
'of i for the column reference where you will see
'that I used i-1.

For i = 2 To Worksheets.Count
For Each Tmprange In Worksheets("YTD").Range("b2:b117")
For Rno = 2 To 117
Svalue = "B" & Trim(Str(Rno))
OValue = "C" & Trim(Str(Rno))

If Trim(Tmprange.Value) = _
Trim(Worksheets(i).Range(Svalue)) Then

Worksheets("YTD").Cells(Tmprange.Row, _
Tmprange.Column + i - 1).Value = _
Trim(Worksheets(i).Range(OValue))
End If

Next Rno
Next
Next i

 

[Harish Sharma]

HI OssieMac,

Thanks for your prompt response, the sheets are not ordered and hence we
will have to sort it(I am not sure if sheet named in format of "Oct07" can
be sorted).

But your code will really help me one step ahead, it is more generic than
mine

 

[OssieMac]

Hi again Harish,

This is another method you can use. Set up a list of the worksheets with the
column number to use for each in an unused area say on your YTD sheet like
the following:-

You will need to format the column as text first before inserting your sheet
names otherwise Excel will think they are dates not strings.

You can set up with names in advance of creating worksheets because the
error routine exits out it does not find the worksheet.

W'Sht Name Col #
Oct07 1
Nov07 2
Dec07 3
Jan08 4
Feb08 5
Mar08 6
Apr08 7
May08 8
Jun08 9

Then the following macro should work. However, as before it is untested so
make sure you have a backup of your workbook.

Sub CopyCol_2()

Dim ws As Worksheet
Dim rngWshts As Range
Dim c As Range
Dim lngCol As Long
Dim tmpRange As Range

'Edit "AA" to the column you use for the worksheet names.
With Worksheets("YTD")
Set rngWshts = Range(Cells(2, "AA"), _
Cells(Rows.Count, "AA").End(xlUp))
End With

For Each c In rngWshts

'Cannot set to non-existant worksheet
On Error GoTo NoMoreSheets 'Exits the routine
Set ws = Worksheets(c.Value)
On Error GoTo 0

lngCol = c.Offset(0, 1) 'Col # for data

For Each tmpRange In Worksheets("YTD").Range("b2:b117")
For Rno = 2 To 117
Svalue = "B" & Trim(Str(Rno))
OValue = "C" & Trim(Str(Rno))

If Trim(tmpRange.Value) = _
Trim(ws.Range(Svalue)) Then

Worksheets("YTD").Cells(tmpRange.Row, _
tmpRange.Column + lngCol).Value = _
Trim(ws.Range(OValue))
End If

Next Rno
Next tmpRange
Next c

NoMoreSheets:

End Sub