Solved: Auto-repeating input error

[Phelony]

Hi guys

I'm trying to build a macro to make the importing of data from monthly extracts easier.

This macro will exist within the master spreadsheet and the incoming extract will be renamed "exract.xls" and then the macro run.

The data is then moved from the single column that can be updated in the extract by the submitting user, into a column that records the data based on how old it is. It's age and relevant "historic update" while preserving the data already in that cell but adding the date and a "-" to seperate the old and new data.

It seemed easier to assemble the data in column X where it's being fed into from the Vlookup, however, when I do this when it hits a cell that meets the criteria defined above, it's just duplicating the date over and over.

Any ideas gentlemen? :dunno

Please note, this isn't complete yet, but I can't carry on until this replication error has been fixed. :banghead: Furthermore, the whole series of activecell offsets is indeed ugly, but it's the only way I can think of to move about the sheet and take data from cells that will change as the code loops down, if there's a better way I'd love to know it! :help

Sub Importchanges()
'copy vlook up where applicable
Range("X2").Select
Range("X2").Formula = "=VLOOKUP(A2,'C:\Documents and Settings\woodja\Desktop\Appendix 10 Merger\[Extract.xls]Extract'!$A:$X,24,FALSE)"
Do Until ActiveCell.Offset(0, -1) = ""
ActiveCell.Copy
ActiveCell.Offset(1, 0).PasteSpecial
Loop
Application.CutCopyMode = False
Range("X2").Select
Do Until ActiveCell.Offset(0, -1) = ""
If WorksheetFunction.IsNA(ActiveCell) Then 'if the vlookup has not returned a result then move onto the next cell
ActiveCell.Offset(1, 0).Select
Else 'go to the next cell
If ActiveCell.Offset(0, -8) = "1" Then 'if this cell relates to a record of 30 days or less
ActiveCell = ActiveCell & " - " & Chr(10) & Date _
& ActiveCell.Offset(0, 1).Value & Chr(10) 'use the contents of the history cell (current offset target) to complete the record
ActiveCell.Copy
ActiveCell.Offset(0, 1).PasteSpecial xlPasteValues
ActiveCell.Offset(0, -1).Select
Application.CutCopyMode = False
Else
End If
If ActiveCell.Offset(0, -7) = "1" Then 'if this cell relates to a record of 30 to 60 days old
ActiveCell = ActiveCell & " - " & Chr(10) & Date _
& ActiveCell.Offset(0, 2).Value & Chr(10) 'use the contents of the history cell to complete the record
ActiveCell.Copy
ActiveCell.Offset(0, 2).PasteSpecial xlPasteValues
ActiveCell.Offset(0, -2).Select
Application.CutCopyMode = False
Else
End If
If ActiveCell.Offset(0, -6) = "1" Then 'if this cell relates to a record of 60 to 90 days old
ActiveCell = ActiveCell & " - " & Chr(10) & Date _
& ActiveCell.Offset(0, 3).Value & Chr(10) 'use the contents of the history cell to complete the record
ActiveCell.Copy
ActiveCell.Offset(0, 3).PasteSpecial xlPasteValues
ActiveCell.Offset(0, -3).Select
Application.CutCopyMode = False
Else
End If
If ActiveCell.Offset(0, -5) = "1" Then 'if this cell relates to a record of 90 to 180 days old
ActiveCell = ActiveCell & " - " & Chr(10) & Date _
& ActiveCell.Offset(0, 4).Value & Chr(10) 'use the contents of the history cell to complete the record
ActiveCell.Copy
ActiveCell.Offset(0, 4).PasteSpecial xlPasteValues
ActiveCell.Offset(0, -4).Select
Application.CutCopyMode = False
Else
End If
ActiveCell.Offset(1, 0).Select
End If
Loop


'move data [values] in relation to variables
'delete vlookup column
'messagebox advising to change the name of or delete the extract file
End Sub


Phel x

[Phelony]

This was an insanely complicated way of solving a relitavely simple issue.

Spreadsheet design changed to accomodate the data better.

Silly me!