susanto
09-12-2013, 04:51 AM
dear all....
i have some code to adapt which my range. Would you help me to easy adapt this code which expected result in "sheet2" start from range "k16" drop down......
with source data in sheet "data" and with title/column "name" as parameter...
i confuse to figure it out, and i 'am newbie about vba
Sub result()
Dim lstRow As Long
Dim i As Long
Application.ScreenUpdating = False
Sheet2.Range("B2:C500").Value = "" 'Change as required
Sheet1.Activate
lstRow = Range("C" & Rows.Count).End(xlUp).Row
For i = 2 To lstRow
If Range("C" & i).Value <> "" Then
Sheet2.Cells(Rows.Count, Range("B1").Column).End(xlUp).Offset(1, 0).Value _
= Sheet1.Range("C" & i).Value
End If
If Range("D" & i).Value <> "" Then
Sheet2.Cells(Rows.Count, Range("C1").Column).End(xlUp).Offset(1, 0).Value _
= Sheet1.Range("D" & i).Value
End If
If Range("E" & i).Value <> "" Then
Sheet2.Cells(Rows.Count, Range("B1").Column).End(xlUp).Offset(1, 0).Value _
= Sheet1.Range("C" & i).Value
Sheet2.Cells(Rows.Count, Range("C1").Column).End(xlUp).Offset(1, 0).Value _
= Sheet1.Range("e" & i).Value
End If
If Range("F" & i).Value <> "" Then
Sheet2.Cells(Rows.Count, Range("B1").Column).End(xlUp).Offset(1, 0).Value _
= Sheet1.Range("C" & i).Value
Sheet2.Cells(Rows.Count, Range("C1").Column).End(xlUp).Offset(1, 0).Value _
= Sheet1.Range("F" & i).Value
End If
If Range("D" & i).Value = "" Then
Sheet2.Cells(Rows.Count, Range("C1").Column).End(xlUp).Offset(1, 0).Value _
= "-"
End If
Next i
Sheet2.Activate
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "I think now you are happy after see your desired Answer"
End Sub
for anybody help me, much appreciated...
i attach woorbook
regards..
m.susanto
i have some code to adapt which my range. Would you help me to easy adapt this code which expected result in "sheet2" start from range "k16" drop down......
with source data in sheet "data" and with title/column "name" as parameter...
i confuse to figure it out, and i 'am newbie about vba
Sub result()
Dim lstRow As Long
Dim i As Long
Application.ScreenUpdating = False
Sheet2.Range("B2:C500").Value = "" 'Change as required
Sheet1.Activate
lstRow = Range("C" & Rows.Count).End(xlUp).Row
For i = 2 To lstRow
If Range("C" & i).Value <> "" Then
Sheet2.Cells(Rows.Count, Range("B1").Column).End(xlUp).Offset(1, 0).Value _
= Sheet1.Range("C" & i).Value
End If
If Range("D" & i).Value <> "" Then
Sheet2.Cells(Rows.Count, Range("C1").Column).End(xlUp).Offset(1, 0).Value _
= Sheet1.Range("D" & i).Value
End If
If Range("E" & i).Value <> "" Then
Sheet2.Cells(Rows.Count, Range("B1").Column).End(xlUp).Offset(1, 0).Value _
= Sheet1.Range("C" & i).Value
Sheet2.Cells(Rows.Count, Range("C1").Column).End(xlUp).Offset(1, 0).Value _
= Sheet1.Range("e" & i).Value
End If
If Range("F" & i).Value <> "" Then
Sheet2.Cells(Rows.Count, Range("B1").Column).End(xlUp).Offset(1, 0).Value _
= Sheet1.Range("C" & i).Value
Sheet2.Cells(Rows.Count, Range("C1").Column).End(xlUp).Offset(1, 0).Value _
= Sheet1.Range("F" & i).Value
End If
If Range("D" & i).Value = "" Then
Sheet2.Cells(Rows.Count, Range("C1").Column).End(xlUp).Offset(1, 0).Value _
= "-"
End If
Next i
Sheet2.Activate
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "I think now you are happy after see your desired Answer"
End Sub
for anybody help me, much appreciated...
i attach woorbook
regards..
m.susanto