Sub Test()
Dim iLastRow As Long
Dim iLastCol As Long
Dim i As Long, j As Long

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 8 Step -1
If Cells(i, "A").Value < "" Then
Cells(i, "D").Value = Range("C2").Value
Cells(i, "E").Value = Range("C3").Value
Cells(i, "F").Value = Range("C4").Value
Range("G" & i).Resize(, 5).ClearContents
Else
Rows(i).Delete
End If
Next i
Range("A1").Value = "Serial Number"
Range("B1").Value = "Model"
Range("C1").Value = "Color"
Range("D1").Value = "Company"
Range("E1").Value = "Date1"
Range("F1").Value = "Date2"
Rows("2:7").Delete

End Sub



--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"DTTODGG" wrote in message
...
I have an excel "form" that people from different companies send me each
month.
The fields a

C2 = Company Name
C3 = Date of Inventory
C4 = Date of Receipt

After that, they give me a list of serial numbers, model names and colors:

A8 = 1234 B8 = Lemon C8 = Yellow
A9 = 2345 B9 = Apple C9 = Red
A10 = 345 B10=Grape C10=Purple
A11 = 678 B11=Apple C11=Red

This goes on down the "form", then there is a second column with the same
data:

E8 = 1234 F8 = Lemon G8 = Yellow
E9 = 2345 F9 = Apple G9 = Red
E10 = 345 F10=Grape G10=Purple

E11 = 678 F11=Apple G11=Red

Sometimes people will "skip" a line for legibility.

I would like to read this data into a spreadsheet format like:

Serial Number Model Color Company Date1 Date2
1234 Lemon Yellow C2 C3 C4
2345 Apple Red C2 C3 C4

I'm not certain I explained this very well. I'm not familiar with VBA, but
it should work something like:
For I = 1 to TheEnd
If A8 < NULL then \
Row I+1 = A8, B8, C8, C2, C3, C4

I hope you can figure this out and help me.
Thanks a bunch!