Hi,
Instead of having 4 macros i decided to merge them into 1.
It works fine when the data set is quite small, but when i have a large one now i get the error Run-time error '6' Overflow.
The debug shows that it is Lastrow = Range("A" & Rows.Count).End(xlUp).Row that is causing the problem. Can anyone see what is wrong
Sub Transform_Data()
Dim x, y(), i&, j&, k&, n&, s$
x = Sheets("TXT").Range("A3").CurrentRegion.Value
ReDim y(1 To UBound(x, 1) * UBound(x, 2) / 10, 1 To 16): k = 5
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 2 To UBound(x)
For j = 6 To UBound(x, 2)
s = x(i, 1) & "~" & x(1, j)
If .Exists(s) Then
n = .Item(s)
Else
n = n + 1: .Item(s) = n
y(n, 1) = x(1, j): y(n, 2) = x(i, 1)
y(n, 3) = x(i, 2): y(n, 4) = x(i, 4)
y(n, 5) = x(i, 5)
End If
If .Exists(x(i, 3)) Then
k = .Item(x(i, 3))
Else
k = k + 1: .Item(x(i, 3)) = k
End If
y(n, k) = x(i, j)
Next j
Next i
End With
With Sheets("Sheet2")
.Range("A2:P" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).ClearContents
.Range("A2:P2").Resize(n).Value = y()
.Activate
End With
Dim Lastrow As Integer
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Range("F2:F" & Lastrow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Worksheets("Master Data").Range("D2:X50000").ClearContents
Range("Data_Macro").Copy Range("Paste_Location")
Sheets("ASF").Select
Range("A1").Select
End Sub
Kind regards and thanks a lot!!!
Bookmarks