Help on VBA and Excel

[AK]

Hallo,
I am not a VBA/Excel programmer, so I would like your help.
The below is what I have. Three columns of Excel in Sheet1.
A B C
---------------------------------------------------
John $30 $0
Smith $20 $10

What I want to do is the following in Sheet2.
A B
--------------------------------
John $30
Smith $20
Smith $10

How would I do it? I'd like your help.

Thanks in advance.

Kumar

 

[Mark Ivey]

Give this one a go...

Mark Ivey

Sub createSummary()
Dim i As Long
Dim j As Long
Dim k As Long

Sheets(1).Select

LastRow = Sheets(1).Range("A65536").End(xlUp).Row

LastCol = Sheets(1).Range("IV1").End(xlToLeft).Column

k = 1

For i = 1 To LastRow
For j = 2 To LastCol
If Cells(i, j).Value > 0 Then
Sheets(2).Cells(k, 1).Value = Sheets(1).Cells(i, 1).Value
Sheets(2).Cells(k, 2).Value = Sheets(1).Cells(i, j).Value
k = k + 1
End If
Next
Next

End Sub

 

[JLGWhiz]

Another method:

Sub MoveToColB()
Dim lastRow, lastRow2 As Long
lastRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
If Sheets(1).Range("C" & i) <> 0 Then
lastRow2 = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(1).Range("A" & i & ":B" & i).Copy _
Sheets(2).Cells(lastRow2 + 1, 1)
lastRow2 = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
Set CRng = Union(Sheets(1).Range("A" & i), Sheets(1).Range("C" & i))
CRng.Copy Sheets(2).Cells(lastRow2 + 1, 1)
Else
lastRow2 = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(1).Range("A" & i & ":B" & i).Copy _
Sheets(2).Cells(lastRow2 + 1, 1)
End If
Next
End Sub

 

[AK]

Give this one a go...

Mark Ivey

Sub createSummary()
Dim i As Long
Dim j As Long
Dim k As Long

Sheets(1).Select

LastRow = Sheets(1).Range("A65536").End(xlUp).Row

LastCol = Sheets(1).Range("IV1").End(xlToLeft).Column

k = 1

For i = 1 To LastRow
For j = 2 To LastCol
If Cells(i, j).Value > 0 Then
Sheets(2).Cells(k, 1).Value = Sheets(1).Cells(i, 1).Value
Sheets(2).Cells(k, 2).Value = Sheets(1).Cells(i, j).Value
k = k + 1
End If
Next
Next

End Sub

Thank you so much for your help.

Kumar

 

[AK]

Another method:

Sub MoveToColB()
Dim lastRow, lastRow2 As Long
lastRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
If Sheets(1).Range("C" & i) <> 0 Then
lastRow2 = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(1).Range("A" & i & ":B" & i).Copy _
Sheets(2).Cells(lastRow2 + 1, 1)
lastRow2 = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
Set CRng = Union(Sheets(1).Range("A" & i), Sheets(1).Range("C" & i))
CRng.Copy Sheets(2).Cells(lastRow2 + 1, 1)
Else
lastRow2 = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(1).Range("A" & i & ":B" & i).Copy _
Sheets(2).Cells(lastRow2 + 1, 1)
End If
Next
End Sub

Thank you. Appreciate your help.

Kumar