Excel vba - Scripting Dictionary - Improve Performance

[vincentzack]

My code need more than one hours to complete for 3500 rows data but I need to work for more than 40000 rows data.
I am looking for alternatives to my code by using dictionary, with improved performance within the context of interest.
Could anyone help me?


<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: inherit;">Sub StripRow2Node()
'Read the Strip Design table
With Sheets("Design-Moment")
Sheets("Design-Moment").Activate
LastR1 = .Range("B" & Cells.Rows.Count).End(xlUp).Row
DM_arr = .Range(Cells(1, 1), Cells(LastR1, 7)) 'Col 1 to Col 7
DM_count = UBound(DM_arr, 1)
End With
'Read the x and y coordinations and thickness of a node in node design
With Sheets("Design-Shear")
Sheets("Design-Shear").Activate
LastR2 = .Range("B" & Cells.Rows.Count).End(xlUp).Row
DS_arr = .Range(Cells(1, 4), Cells(LastR2, 5)) 'Col 4 to Col 5
SX_arr = .Range(Cells(1, 26), Cells(LastR2, 27))
SY_arr = .Range(Cells(1, 30), Cells(LastR2, 31))
DS_count = UBound(DS_arr, 1)
End With

'** Find correponding reference row in Design-Moment for nodes**
'Match node to striip station and output row index
For i = 5 To DS_count
XStrip = SX_arr(i, 1)
XStation = DS_arr(i, 1)
YStrip = SY_arr(i, 1)
YStation = DS_arr(i, 2)
For j = 5 To DM_count
If DM_arr(j, 1) = XStrip Then 'X-Strip Name is matched
If DM_arr(j, 4) >= XStation And DM_arr(j - 1, 4) < XStation Then
SX_arr(i, 2) = j 'matched row reference for X-strip
End If
End If
If DM_arr(j, 1) = YStrip Then
If DM_arr(j, 5) <= YStation And DM_arr(j - 1, 5) > YStation Then
SY_arr(i, 2) = j
End If
End If
Next j
Next i
'Write the matched strip information to node
For i = 5 To LastR2
With Sheets("Design-Shear")
.Cells(i, 27) = SX_arr(i, 2)
.Cells(i, 31) = SY_arr(i, 2)
End With
Next i
End sub</code>

 

[RedBeard]

Define your variables.

Do you really need to activate your sheets?

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Activesheet.DisplayPageBreaks = False

‘Place your macro code here

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Activesheet.DisplayPageBreaks = True

 

[Ombir]

My code need more than one hours to complete for 3500 rows data but I need to work for more than 40000 rows data.
I am looking for alternatives to my code by using dictionary, with improved performance within the context of interest.
Could anyone help me?


<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: inherit;">Sub StripRow2Node()
'Read the Strip Design table
With Sheets("Design-Moment")
Sheets("Design-Moment").Activate
LastR1 = .Range("B" & Cells.Rows.Count).End(xlUp).Row
DM_arr = .Range(Cells(1, 1), Cells(LastR1, 7)) 'Col 1 to Col 7
DM_count = UBound(DM_arr, 1)
End With
'Read the x and y coordinations and thickness of a node in node design
With Sheets("Design-Shear")
Sheets("Design-Shear").Activate
LastR2 = .Range("B" & Cells.Rows.Count).End(xlUp).Row
DS_arr = .Range(Cells(1, 4), Cells(LastR2, 5)) 'Col 4 to Col 5
SX_arr = .Range(Cells(1, 26), Cells(LastR2, 27))
SY_arr = .Range(Cells(1, 30), Cells(LastR2, 31))
DS_count = UBound(DS_arr, 1)
End With

'** Find correponding reference row in Design-Moment for nodes**
'Match node to striip station and output row index
For i = 5 To DS_count
XStrip = SX_arr(i, 1)
XStation = DS_arr(i, 1)
YStrip = SY_arr(i, 1)
YStation = DS_arr(i, 2)
For j = 5 To DM_count
If DM_arr(j, 1) = XStrip Then 'X-Strip Name is matched
If DM_arr(j, 4) >= XStation And DM_arr(j - 1, 4) < XStation Then
SX_arr(i, 2) = j 'matched row reference for X-strip
End If
End If
If DM_arr(j, 1) = YStrip Then
If DM_arr(j, 5) <= YStation And DM_arr(j - 1, 5) > YStation Then
SY_arr(i, 2) = j
End If
End If
Next j
Next i
'Write the matched strip information to node
For i = 5 To LastR2
With Sheets("Design-Shear")
.Cells(i, 27) = SX_arr(i, 2)
.Cells(i, 31) = SY_arr(i, 2)
End With
Next i
End sub</code>

Its very difficult and time consuming to understand what you want to achieve from code.

It would be easier for everyone to help if you post your Input and Output Data in the Worksheet format like I posted below.

Book1
	A	B	C	D	E	F	G
1	Col1	Col2	Col3	Col4	Col5	Col6	Col7
2	-25	-24	-42	-72	-88	-78	-24
3	-81	-53	-56	-3	-74	-38	-28
4	-61	-7	-72	-98	-12	-66	-70
5	-5	-63	-54	-49	-8	-59	-49
6	-16	-16	-41	-1	-97	-4	-31
7	-15	-75	-69	-28	-44	-42	-23
8	-14	-5	-1	-31	-48	-63	-20
9	-24	-54	-5	-9	-68	-76	-57
10	-27	-8	-8	-4	-51	-59	-70
11	-81	-61	-67	-35	-60	-20	-91
12	-35	-84	-61	-24	-33	-21	-54
13	-16	-65	-93	-30	-29	-39	-84
14	-5	-42	-27	-20	-22	-94	-25
Design-Moment

[TABLE="width: 85%"]
<tbody>[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]