HELP please, thanks

[Annemus]

Hello . I have a problem, where my VBA writes the same data in ALL the rows in the columns above instead of JUST the first empty one found. (To explain nearer: If I run the VBA-code the next day, then it writes the new data in the next empty row, BUT also overwrites the data from yesterday)

PLEASE help me fix this, so it only writes in the next empty row and does not overwrites the data above.
My VBA-code is as following:


Sub Dagsopdatering()
Sheets("Dagens pris").Select
Range("A1:G1000").Clear
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.ok.dk/priser/benzin-olie-priser", Destination:=Range("$A$1"))
.Name = "benzin-olie-priser"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With


Dim Emptyrow As Long
'Writes the date today'
Sheets("Priser").Select
Range("E4").Value = Date
Sheets("Info").Select
Range("G1").Value = Date

'Finds the first empty row in the column, and then copys into the first empty row'
Sheets("Priser").Select
Emptyrow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("E4").Copy Destination:=Range("A" & Emptyrow)
Range("F4").Copy Destination:=Range("B" & Emptyrow)
Range("G4").Copy Destination:=Range("C" & Emptyrow)
End Sub

Thanks in advance

 

[JackDanIce]

I have changed your code slightly and highlighted a particular row in the code:

Sub Dagsopdatering()


Application.ScreenUpdating = False

With Sheets("Dagens pris")
    .Range("A1:G1000").ClearContents
    With .QueryTables.Add(Connection:="URL;http://www.ok.dk/priser/benzin-olie-priser", Destination:=Range("A1"))
        .Name = "benzin-olie-priser"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End With


Dim Emptyrow As Long
'Writes the date today'
Sheets("Info").Range("G1") = Date

'Finds the first empty row in the column, and then copys into the first empty row'
With Sheets("Priser")
    .Range("E4") = Date
     Emptyrow = .Range("A" & Rows.Count).End(xlUp).Row + 1
    MsgBox Emptyrow
    .Range("A" & Emptyrow) = .Range("E4")
    .Range("B" & Emptyrow) = .Range("F4")
    .Range("C" & Emptyrow) = .Range("G4")
End With
    
With Application
    .ScreenUpdating = True
    .Goto Sheets("Priser").Range("A1")
End With
    
End Sub

Check the number that your Emptyrow variable is assigned. I think it should be 5 or more and if not, there's a problem with how your data is being imported in

 

[Annemus]

I just found the error.. The data comes into the sheet as " ='Dagens pris'!$B$49 " in the formula line.
Hwo do I change that, so it just copy the the data into E4, F4 and G4 instead of locking the emptyrows data to the data that is changing day by day ??

 

[JackDanIce]

Not sure I understand what you mean.

Are the values in E4, F4 and G4 changing and you want the macro to copy and paste values into the same cells after it's run?

 

[Annemus]

I am sorry. I meant this:

Hwo do I change that, so it just copy the data from E4, F4 and G4, instead of locking the emptyrows data to be equal to respectavely E4, F4 and G4, so the data that is changing day by day, when the data in this changes ??

The data in the first empty row has to be constant after writting in it the first time..
I have tried copy, but didn't work without posting error when running

 

[JackDanIce]

Still not 100% sure I understand what you mean but try:

Sub Dagsopdatering()


Application.ScreenUpdating = False

With Sheets("Dagens pris")
    .Range("A1:G1000").ClearContents
    With .QueryTables.Add(Connection:="URL;http://www.ok.dk/priser/benzin-olie-priser", Destination:=Range("A1"))
        .Name = "benzin-olie-priser"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End With


Dim Emptyrow As Long
'Writes the date today'
Sheets("Info").Range("G1") = Date

'Finds the first empty row in the column, and then copys into the first empty row'
With Sheets("Priser")
    .Range("E4") = Date
     Emptyrow = .Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("E4:G4").Value = .Range("E4:G4").Value
End With
    
With Application
    .ScreenUpdating = True
    .Goto Sheets("Priser").Range("A1")
End With
    
End Sub

Part in red is new change I've made

 

[Annemus]

Thank you. I think it works perfectly now. Hope it will tomorrow when I opdate.. Thank you so much.

 

[JackDanIce]

You're welcome