Efficiency Issue

[PKG]

Hi,

I've written some code to loop through a worksheet and create a "summary" sheet of types. The code works, only it takes far too long, and I'd like a bit of advice on an alternative method that will perform the same task quicker.

I've attached the example file with the working macro. The macro will run quickly with the data in the example file, only when huge lists are introduced, it takes too long.

Any suggestions welcome, as I'm sure my "activecell" method is not the most effecient.

Thanks

PKG

[Bob Phillips]

Sub DataCrunch()

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

DistanceString1 = vbNullString
DistanceString2 = vbNullString

With Sheets("RawData")

'Type and max distance
DistanceString3 = .Range("F2").Value & " within " & .Range("G2").Value & "km"

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
nextrow = 2

'Loops through sites and builds up values
For i = 2 To LastRow

'If it is a different site to the last one
If .Cells(i, "A").Value <> DistanceString1 Then

DistanceString1 = .Cells(i, "A").Value
DistanceString2 = .Cells(i, "B").Value & " - " & Round(.Cells(i, "C").Value, 1) & "km " & .Cells(i, "E").Value
'or the same as The last
ElseIf .Cells(i, "A").Value = DistanceString1 Then

DistanceString2 = DistanceString2 + ", " & .Cells(i, "B").Value & " - " & Round(.Cells(i, "C").Value, 1) & "km " & .Cells(i, "E").Value
End If

'Is it the end of this site? If so, fill in the distances sheet with string values
If .Cells(i, "A").Value <> .Cells(i + 1, "A").Value Then

'Finished updating 1 site
Sheets("Distances").Cells(nextrow, "B").Value = DistanceString1
Sheets("Distances").Cells(nextrow, "C").Value = DistanceString3
Sheets("Distances").Cells(nextrow, "D").Value = DistanceString2
Sheets("Distances").Cells(nextrow, "A").Value = DistanceString1 & "-" & DistanceString3

nextrow = nextrow + 1
End If
Next i
End With

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

[PKG]

Thanks XLD, that's helped considerably.

I have another question which has been bothering us for a while... what is the best way of importing text from a CSV (for example) into an excel sheet, preferably without extablishing a data connection using VBA?

I've tried two ways, one was crudely to open the csv, copy the cells and paste them to the workbook, which was pretty terrible.

The current way I do it is using a text stream object:

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(Filepath)
Set ts = f.OpenAsTextStream(1, TristateUseDefault)
Range("A1").Activate
n = 1
Do While ts.AtEndOfStream <> True

ActiveCell.Value = ts.ReadLine
ActiveCell.Offset(1, 0).Activate
n = n + 1

Loop
ts.Close

This is also very slow.

Any help on this much appreciated.

PKG

[Bob Phillips]

I always do it your crude way. I don't use TextStream, it is another set of methods I have to learn, and I don't have a problem with copy/paste, so it has not been an issue for me.