Transform macro
 

Please help with a macro to tranfom the ff:
Column B1, C1 .... contains Job Role
Column B2, C2 .... contains Course Code
Row A3 ... contains UserID
B3 ... contains X indicating UserID has been assigned Job
Role B1 ans so on. The range may be set A1:T1000

A B C D E F G H
1 SD00:Display SD00:Product_MNG
2UserID SD 03 SD04
3IR_00783A x
4IR_01693B x


Must be tranformed to a new worksheet containing UserID
and Job Role

A B
1IR_00783A SD00:Display
2IR_01693B SD00:Product_MG

Transform macro
 

Try this,

Sub Test()
Dim c As Range, firstAddress
Dim SourceSheet As Worksheet
Dim DestSheet As Worksheet
Dim ri As Long

Set SourceSheet = Worksheets("sheet1") 'ActiveSheet ' change to suit
Set DestSheet = Worksheets("database") ' Destination sheet

With SourceSheet.Range("a1:t1000")
Set c = .Find("X", LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
ri = ri + 1
DestSheet.Cells(ri, 1) = SourceSheet.Cells(c.Row, 1)
DestSheet.Cells(ri, 2) = SourceSheet.Cells(1, c.Column)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

End Sub
Regards,
Shailesh Shah
http://members.lycos.co.uk/shahweb/



"JA" wrote:

Please help with a macro to tranfom the ff:
Column B1, C1 .... contains Job Role
Column B2, C2 .... contains Course Code
Row A3 ... contains UserID
B3 ... contains X indicating UserID has been assigned Job
Role B1 ans so on. The range may be set A1:T1000

A B C D E F G H
1 SD00:Display SD00:Product_MNG
2UserID SD 03 SD04
3IR_00783A x
4IR_01693B x


Must be tranformed to a new worksheet containing UserID
and Job Role

A B
1IR_00783A SD00:Display
2IR_01693B SD00:Product_MG