mercmannick
07-18-2006, 01:28 PM
hi
Enclosed is a book with all the relevant code ,
i have managed to modify code from a previous post , but just cant get VBA to put in the right place on sheet, if someone could show me where i am going wrong
Private Sub SetCells_EXTERNAL()
Dim DataRow As Long, Cel As Range, Cols, c
'Get next row to fill
DataRow = Sheets("Data Access").Range("B2").End(xlUp).Row + 1
'Fill data
For Each Cel In Range([H2], [H2].End(xlDown))
Select Case Cel
Case "Speed"
Cells(DataRow, "B") = Cel.Offset(, 1)
Case "Cell E"
Cells(DataRow, "C") = Cel.Offset(, 1)
Case "Cell F"
Cells(DataRow, "D") = Cel.Offset(, 1)
Case "M74"
Cells(DataRow, "E") = Cel.Offset(, 1)
Case "Cell G"
Cells(DataRow, "F") = Cel.Offset(, 1)
Case "Cell W"
Cells(DataRow, "G") = Cel.Offset(, 1)
Case "S15"
Cells(DataRow, "H") = Cel.Offset(, 1)
Case "S70"
Cells(DataRow, "I") = Cel.Offset(, 1)
Case "S17"
Cells(DataRow, "J") = Cel.Offset(, 1)
End Select
Next
' 'Check and fill blanks
Cols = Array("B", "C", "D", "E", "F", "G", "H", "I", "J")
For Each c In Cols
If Cells(DataRow, c) = "" Then Cells(DataRow, c) = 0
Next
End Sub
Many Thanks
Merc
Enclosed is a book with all the relevant code ,
i have managed to modify code from a previous post , but just cant get VBA to put in the right place on sheet, if someone could show me where i am going wrong
Private Sub SetCells_EXTERNAL()
Dim DataRow As Long, Cel As Range, Cols, c
'Get next row to fill
DataRow = Sheets("Data Access").Range("B2").End(xlUp).Row + 1
'Fill data
For Each Cel In Range([H2], [H2].End(xlDown))
Select Case Cel
Case "Speed"
Cells(DataRow, "B") = Cel.Offset(, 1)
Case "Cell E"
Cells(DataRow, "C") = Cel.Offset(, 1)
Case "Cell F"
Cells(DataRow, "D") = Cel.Offset(, 1)
Case "M74"
Cells(DataRow, "E") = Cel.Offset(, 1)
Case "Cell G"
Cells(DataRow, "F") = Cel.Offset(, 1)
Case "Cell W"
Cells(DataRow, "G") = Cel.Offset(, 1)
Case "S15"
Cells(DataRow, "H") = Cel.Offset(, 1)
Case "S70"
Cells(DataRow, "I") = Cel.Offset(, 1)
Case "S17"
Cells(DataRow, "J") = Cel.Offset(, 1)
End Select
Next
' 'Check and fill blanks
Cols = Array("B", "C", "D", "E", "F", "G", "H", "I", "J")
For Each c In Cols
If Cells(DataRow, c) = "" Then Cells(DataRow, c) = 0
Next
End Sub
Many Thanks
Merc