Hi I'm strugling to write some VBA code, it's a bit untidy at present but it works untill I try to import values from sheet 2 to sheet1, I get an object error, but it dosen't mean anything to me.
Any help greatfully recieved.
Basically this code looks at sheet2 if the data is the same it overwrites it with upto date data, else it will add new unique enteries
to the last row.
Many thanks
Mike
Sub Importer()
Dim y As Integer
Dim z As Integer
Dim R As Long
'database
Sheets("Sheet1").Select
Cells(1, 1).Select
Range(Selection, Selection.End(xlDown)).Select
R = Selection.Rows.Count
'daily data
Sheets("Sheet2").Select
Cells(1, 1).Select
Dim Amax As Integer
'this is the number of rows in the first unique column ie Daily List, created
'by selection
Dim Bmax As Integer
'this is the number of rows in the second unique column ie Our in database List, created
'by selection
Range(Selection, Selection.End(xlDown)).Select
Bmax = Selection.Rows.Count
Cells(1, 1).Select
Sheets("Sheet1").Select
Cells(1, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Amax = Selection.Rows.Count
Cells(2, 4).Select
Application.ScreenUpdating = False
'Range(Selection, Selection.End(xlDown)).Select
'R = Selection.Rows.Count
z = 2
y = 2
For z = 2 To Amax
For y = 2 To Bmax
If Sheet2.Cells(y, 4) = Sheet1.Cells(z, 4) Then
'NEXT LINE WON'T WORK
Sheet1.Range(Cells(z, 1), Cells(z, 18)).Value = Sheet2.Range(Cells(y, 1), Cells(y, 18)).Value
'Sheets("Sheet2").Select
'Cells(y, 14).EntireRow.Copy
'Selection.Copy
'database
Sheets("Sheet1").Select
Sheet1.Cells(y, 14).Select
Sheets("Sheet1").Paste
z = z + 1
y = 2
'daily
Sheets("Sheet2").Select
Else: Sheet2.Cells(z, 14).Select
'Range(Selection, Selection.End(xlToRight)).Select
Cells(z, 14).EntireRow.Copy
'Selection.Copy
R = R + 1
'inportlist
Sheets("Sheet1").Select
Sheet1.Cells(R, 14).Select
Cells(R, 14) = "QQQ"
End If
Next y
Next z
Application.ScreenUpdating = True
End Sub
Any help greatfully recieved.
Basically this code looks at sheet2 if the data is the same it overwrites it with upto date data, else it will add new unique enteries
to the last row.
Many thanks
Mike
Sub Importer()
Dim y As Integer
Dim z As Integer
Dim R As Long
'database
Sheets("Sheet1").Select
Cells(1, 1).Select
Range(Selection, Selection.End(xlDown)).Select
R = Selection.Rows.Count
'daily data
Sheets("Sheet2").Select
Cells(1, 1).Select
Dim Amax As Integer
'this is the number of rows in the first unique column ie Daily List, created
'by selection
Dim Bmax As Integer
'this is the number of rows in the second unique column ie Our in database List, created
'by selection
Range(Selection, Selection.End(xlDown)).Select
Bmax = Selection.Rows.Count
Cells(1, 1).Select
Sheets("Sheet1").Select
Cells(1, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Amax = Selection.Rows.Count
Cells(2, 4).Select
Application.ScreenUpdating = False
'Range(Selection, Selection.End(xlDown)).Select
'R = Selection.Rows.Count
z = 2
y = 2
For z = 2 To Amax
For y = 2 To Bmax
If Sheet2.Cells(y, 4) = Sheet1.Cells(z, 4) Then
'NEXT LINE WON'T WORK
Sheet1.Range(Cells(z, 1), Cells(z, 18)).Value = Sheet2.Range(Cells(y, 1), Cells(y, 18)).Value
'Sheets("Sheet2").Select
'Cells(y, 14).EntireRow.Copy
'Selection.Copy
'database
Sheets("Sheet1").Select
Sheet1.Cells(y, 14).Select
Sheets("Sheet1").Paste
z = z + 1
y = 2
'daily
Sheets("Sheet2").Select
Else: Sheet2.Cells(z, 14).Select
'Range(Selection, Selection.End(xlToRight)).Select
Cells(z, 14).EntireRow.Copy
'Selection.Copy
R = R + 1
'inportlist
Sheets("Sheet1").Select
Sheet1.Cells(R, 14).Select
Cells(R, 14) = "QQQ"
End If
Next y
Next z
Application.ScreenUpdating = True
End Sub