Help with VBA Macro Reading Excel "form"

[DTTODGG]

I have an excel “form†that people from different companies send me each month.
The fields are:

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!

 

[Yngve]

Hi DTTODGG

Try this, it is simpel but it works. Change worksheets name so it
fits for you.

Sub rrr()
Dim kolA As Double
Dim i As Double

kolA = Cells(Rows.Count, "A").End(xlUp).Row
For i = 8 To kolA
If Range("A" & i) <> "" Then
Worksheets("Ark2").Range("A" & (i - 6) & ":C" & (i - 6)) = _
ActiveSheet.Range("A" & i & ":C" & i).Value
Worksheets("Ark2").Range("D" & (i - 6)) = _
ActiveSheet.Range("C2")
Worksheets("Ark2").Range("E" & (i - 6)) = _
ActiveSheet.Range("C3")
Worksheets("Ark2").Range("F" & (i - 6)) = _
ActiveSheet.Range("C4")
Else
MsgBox " No data!!!"
Exit Sub
End If
Next i




End Sub


Regards Yngve

 

[Bob Phillips]

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)