Hi

I have written my code as follows in VBA. The problem is it takes lot of
time to open the spreadsheet. If there is anyway I can improve my code.

Code is as follows

Dim lastrow2 As Long, s5 As Variant, s6 As Variant
Dim i2 As Long, col2 As Long, rw2 As Long


Application.Worksheets("weeklysourcedata").Select

lastrow2 = Cells(Rows.Count, 1).End(xlUp).Row

s5 = Cells(2, 1).Value
s6 = Cells(2, 2).Value
s7 = cells(2,3).Value
col2 = 3
rw2 = 2
For i2 = 2 To lastrow2
If Cells(i2, 1) = s5 And Cells(i2, 2) = s6 and cells(i2, 3) = s7 Then
col2 = col2 + 1
Else
col2 = 4
rw2 = rw2 + 1
s5 = Cells(i2, 1)
s6 = Cells(i2, 2)

End If
Worksheets("weeklycopydata").Cells(rw2, col2) = Cells(i2, 6).Value
Worksheets("weeklycopydata").Cells(rw2, 2) = Cells(i2, 1).Value
Worksheets("subbrands").Cells(rw2, 2) = Cells(i2, 1).Value
Worksheets("weeklycopydata").Cells(rw2, 3) = Cells(i2, 2).Value
Worksheets("subbrands").Cells(rw2, 3) = Cells(i2, 2).Value
Worksheets("subbrands").Cells(rw2, col2) = Cells(i2, 8).Value
Next i2

--
Kittie

Open the workbook first

Workbooks.Open filename:=...

"Lolly" wrote in message
...
Hi

I have written my code as follows in VBA. The problem is it takes lot of
time to open the spreadsheet. If there is anyway I can improve my code.

Code is as follows

Dim lastrow2 As Long, s5 As Variant, s6 As Variant
Dim i2 As Long, col2 As Long, rw2 As Long


Application.Worksheets("weeklysourcedata").Select

lastrow2 = Cells(Rows.Count, 1).End(xlUp).Row

s5 = Cells(2, 1).Value
s6 = Cells(2, 2).Value
s7 = cells(2,3).Value
col2 = 3
rw2 = 2
For i2 = 2 To lastrow2
If Cells(i2, 1) = s5 And Cells(i2, 2) = s6 and cells(i2, 3) = s7 Then
col2 = col2 + 1
Else
col2 = 4
rw2 = rw2 + 1
s5 = Cells(i2, 1)
s6 = Cells(i2, 2)

End If
Worksheets("weeklycopydata").Cells(rw2, col2) = Cells(i2, 6).Value
Worksheets("weeklycopydata").Cells(rw2, 2) = Cells(i2, 1).Value
Worksheets("subbrands").Cells(rw2, 2) = Cells(i2, 1).Value
Worksheets("weeklycopydata").Cells(rw2, 3) = Cells(i2, 2).Value
Worksheets("subbrands").Cells(rw2, 3) = Cells(i2, 2).Value
Worksheets("subbrands").Cells(rw2, col2) = Cells(i2, 8).Value
Next i2

--
Kittie