I am working with two sheets: -
Sheet1 has a text value that I am adding into sheet2 but I am adding this value multiple times based on the number of weeks within a date range selected. If my date range has 4 weeks in between, then I add the text value into 4 rows of the column selected. If there are 5 weeks, then I add the value into 5 rows. My problem with this is performance. On average, I have about 250 records in sheet1 but there are duplicates which I check for and ignore and then only add the ones that are not already added. Doing this takes between 10 - 12 seconds which is a bit too long. I have mentioned 1 column but I do this for many columns using the same method and this takes about 4 minutes. How can I improve the performance. This is what my code looks like
>>> use code - tag <<<
Sheet1 has a text value that I am adding into sheet2 but I am adding this value multiple times based on the number of weeks within a date range selected. If my date range has 4 weeks in between, then I add the text value into 4 rows of the column selected. If there are 5 weeks, then I add the value into 5 rows. My problem with this is performance. On average, I have about 250 records in sheet1 but there are duplicates which I check for and ignore and then only add the ones that are not already added. Doing this takes between 10 - 12 seconds which is a bit too long. I have mentioned 1 column but I do this for many columns using the same method and this takes about 4 minutes. How can I improve the performance. This is what my code looks like
>>> use code - tag <<<
Code:
Dim A, AB, B, BA, Y, V, L&, X, C, R&, S, BB
Set s1 = ActiveWorkbook.Worksheets("System1") 'These names are not used
Set s2 = ActiveWorkbook.Worksheets("System2")
Set s3 = ActiveWorkbook.Worksheets("System3")
Set s4 = ActiveWorkbook.Worksheets("System4")
Set s5 = ActiveWorkbook.Worksheets("System5")
On Error GoTo EH
'Get the values of the first column
A = s2.UsedRange.Columns(intPersonID).Value
ReDim V(1 To (UBound(A)) * 10, 0)
N = 1
S = 1
R = 0
AZ = 1
BB = ""
For BA = 1 To UBound(A)
If BA = 1 Then
V(R + N, 0) = "ID"
R = R + 1
Set strChar = s4.Range(Split(Cells(1, AZ).Address, "$")(1) & "1")
BB = "ID"
strChar.Resize(R) = V
Else
If CStr(A(BA, 1)) <> CStr(BB) Then
For AB = 1 To 5 'intWeeks
V(R + N, 0) = "'" & (A(BA, 1))
R = R + 1
Set strChar = s4.Range(Split(Cells(1, AZ).Address, "$")(1) & "1")
strChar.Resize(R) = V
BB = (A(BA, 1))
Next
End If
End If
Next
EH:
Resume Next
End Sub
Last edited by a moderator: