PDA

View Full Version : Solved: access to excel need help



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

mercmannick
07-18-2006, 01:28 PM
sorry forgot to add Book

Sheets data access it is putting values in, i am trying to get it into Sheets"Data" in relevant place.

Merc

mdmackillop
07-18-2006, 03:08 PM
Sub SetCells_EXTERNAL()
Dim TargCol As Long, Rw As Long, a As Range, Cel As Range
Application.ScreenUpdating = False
TargCol = Sheets("Data").[AC2].End(xlToLeft).Column + 1
With Sheets("Data")
For Each Cel In Range([K2], [K2].End(xlDown))
Set a = Cel.Range("B1:E1")
Rw = .Columns(1).Find(what:=Cel, lookat:=xlWhole).Row
a.Copy
.Cells(Rw, TargCol).PasteSpecial Paste:=xlPasteValues, _
Transpose:=True
Next
End With
Sheets("Data").Activate
'Check and fill blanks
Set a = Range(Cells(2, TargCol), Cells(37, TargCol))
For Each Cel In a
If Cel = "" Then Cel = 0
Next
With a.Font
.FontStyle = "Bold"
.ColorIndex = 3
End With
Cells(1, TargCol).Select
Application.ScreenUpdating = True
End Sub

mercmannick
07-19-2006, 11:29 AM
mdmackillop

Fantastic thanks , works like a dream

Merc

:friends: