Try some light bedtime reading :-
Hope it helps!!!!
Sub MG26Sep19
Dim Sht As Worksheet
Dim Dic As Object
Dim Str As String
Dim nRng As Range
Dim Num As Integer
Dim Site As String
Dim R As Range
Dim Rng As Range
Dim Dn As Range
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
'################
'The code between the "#" lines does the following:-
'Looks in Sheets "Download of Costs", column "A" and Creates individual ranges of cells
'Split by the Word "CONTRA" in column "A"
'The code then loops through each of these ranges collecting the sheet name (Column "B" in
'line with word "CONTRA" 'and all the SheetName related numbers codes, and their column "D" values.
'these Values and Numbers and sheet Names are held in the Dictionary object "Dic"
With Sheets("Download of Costs")
Set Rng = .Range(.Range("A10"), .Range("A" & Rows.Count).End(xlUp))
End With
' First loop Creates String of range addresses "Str" split by word "CONTRA"
For Each Dn In Rng
If Dn = "CONTRAC" Then
If Str = "" Then
Str = Str & "," & Dn.Address
Else
Str = Str & ":" & Dn.Offset(-1).Address & "," & Dn.Address
End If
End If
Next Dn
'Creates str of range Addresses
Str = Str & ":" & Range("A" & Rng.Count + 10).Address
'Creates a new range "nRng" object relating the the "str" addresses
Set nRng = Range(Mid(Str, 2))
MsgBox nRng.Address(external:=True) ' This will show you all the range Addresss
'These individual ranges are split into each range Area
For Each Dn In nRng.Areas
'Find the position of the word "Site" within the text string in column "B" next to "CONTRA"
Num = InStr(Dn(1).Offset(, 1), "Site")
'Site" is the variable relting to the "Site Name" found in column"B" next to "CONTRA"
Site = Mid(Dn(1).Offset(, 1), Num, (Len(Trim(Dn(1).Offset(, 1))) - Num) - 1)
'Variable "Dn" is the individual range within each opf the ranges withing nRng.areas"
For Each R In Dn
'If the value in column "A" is a number then record its column "D" value
If Application.IsNumber(R.Value) = True Then
If Not Dic.exists(Site) Then
Set Dic(Site) = CreateObject("Scripting.Dictionary")
End If
'Dic "Site" is the Sheet name taken from column "B", r.value is the number in column "A"
'R.offset*,4) is the value in column "D"
Dic(Site)(R.Value) = R.Offset(, 4)
End If
Next R
Next Dn
''''All the "CONTRA" numbers relating to the sheet names and their values are now held in the dictionary
'###############
'The code then loops through Each sheet Column "A" checking
For Each Sht In Worksheets
If Not Sht.Name = "Download of Costs" Then
'If the sheet name In the Dictionary from sheet "Download of Costs" has any values then proceed:-
If Dic.exists(Sht.Name) Then
With Sheets(Sht.Name)
'Set "Rng" variable (Column "A" values) relating to to sheet Name
Set Rng = .Range(.Range("A10"), .Range("A" & Rows.Count).End(xlUp))
End With
'Loo0p through column "A" of each sheet (other than "Download of Costs"
For Each Dn In Rng
'If the dictionary has a value relating to "Sheet Name" and column "A" "Number" then
' Place value in Sheet (Sht.name), column "COST TO DATE" , in same row as Column "A" number.
If Dic(Sht.Name).exists(Dn.Value) Then
Dn.Offset(, 3).Value = Dic(Sht.Name).Item(Dn.Value)
End If
Next Dn
End If
End If
Next Sht
MsgBox "Run"
End Sub
Regards Mick
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks