vba macro help!

[jonwong]

Hi, I'm a newbie to using Excel macro and writing VB script. I want to change columns to rows. I've almost finished the code but I want to elimate the row which are null with the 3rd column. Can you please help?

From this:
TITLE | ALT | Image1 | Image2
Product A , ALT A , a1.jpg,a2.jpg
Product B , ALT B , b1.jpg
Product C , ALT C , c1.jpg , c2.jpg

My code do this:
[DETAILED_IMAGES]
!PRODUCTCODE !ALT !IMAGE
Product A ALT A a1.jpg
Product A ALT A a2.jpg
Product B ALT B b1.jpg
Product B ALT B
Product C ALT C c1.jpg
Product C ALT C c2.jpg


As you see the 4th row 3rd column is empty so I want the script to eliminate any row with 3rd column that are empty

I want this:

My code do this:
[DETAILED_IMAGES]
!PRODUCTCODE !ALT !IMAGE
Product A ALT A a1.jpg
Product A ALT A a2.jpg
Product B ALT B b1.jpg
Product C ALT C c1.jpg
Product C ALT C c2.jpg



I've just copied and pasted some where and modify the code:
-------------------------------------------------------------
Sub CHANGE_COLUMNS_TO_ROWS()

Dim lc As Double
Dim i As Long
Dim dlr As Long
Dim SourceSheet As String

Application.ScreenUpdating = False
SourceSheet = ActiveSheet.Name
lc = Cells(1, Columns.Count).End(xlToLeft).Column
Sheets.Add
With Sheets(SourceSheet)
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
dlr = Cells(Rows.Count, 1).End(xlUp).Row + 1

Cells(dlr, 1).Resize(lc - 2).Value = .Cells(i, 1).Value
Cells(dlr, 2).Resize(lc - 2).Value = .Cells(i, 2).Value
.Cells(i, 3).Resize(, lc - 2).Copy
Cells(dlr, 3).PasteSpecial Paste:=xlPasteAll, Transpose:=True
'start another loop with another record
Next i
End With
Range("a2").Select
ActiveWindow.FreezePanes = True
Range("a1") = "!PRODUCTCODE"
Range("b1") = "!ALT"
Range("c1") = "!IMAGE"
Columns(3).Style = "Comma"
Columns.AutoFit
'===
Application.ScreenUpdating = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "[DETAILED_IMAGES]"

End Sub

 

[jonwong]

I think i've got it done:


Sub Delete_Unchanged_Prices()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Rng As Range, ix As Long
Set Rng = Intersect(Range("C2:C665536"), ActiveSheet.UsedRange)
For ix = Rng.Count To 1 Step -1
If Trim(Replace(Rng.Item(ix).Text, Chr(160), Chr(32))) = "" Then
Rng.Item(ix).EntireRow.Delete
End If
Next
done:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub