Hi Peter, here is an extract of some commands and is the point that the code blocks. It blocks over the
c As Long, and due to the change of code place, the error now is follows:
Compile error:
Duplicate declaration in current scope
I know that you will find the solution and i appreciate your support.
Thanks in advance
strWS = InputBox(Prompt:="Enter worksheet name", Title:="Filename", Default:="OCCUPANCIES 2018")
lr = Range("B" & Rows.Count).End(xlUp).Row
With ActiveSheet.Range("B1:B" & lr)
Set c = .Find(What:="Occupancy", LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
c.Offset(, 1) = "=VLOOKUP(R1C3,'\OCCUPANCIES\[" & strWS & ".xlsx]Sheet1'!R3C1:R1000C13,MATCH(R6C3,'\OCCUPANCIES\[" & strWS & ".xlsx]Sheet1'!R1C1:R1C13,0),0)"
c.Offset(, 2) = "=VLOOKUP(R1C3,'\OCCUPANCIES\[" & strWS & ".xlsx]Sheet1'!R3C14:R1000C26,MATCH(R6C3,'\OCCUPANCIES\[" & strWS & ".xlsx]Sheet1'!R1C14:R1C26,0),0)"
c.Offset(, 3) = "=VLOOKUP(R1C3,'\OCCUPANCIES\[" & strWS & ".xlsx]Sheet1'!R3C27:R1000C39,MATCH(R6C5,'\OCCUPANCIES\[" & strWS & ".xlsx]Sheet1'!R1C27:R1C39,0),0)"
c.Offset(, 4) = "=VLOOKUP(R1C3,'\OCCUPANCIES\[" & strWS & ".xlsx]Sheet1'!R3C40:R1000C52,MATCH(R6C5,'\OCCUPANCIES\[" & strWS & ".xlsx]Sheet1'!R1C40:R1C52,0),0)"
End If
End With
Columns("A:A").ColumnWidth = 3.44
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
On Error Resume Next
Columns("A").Find(What:="TELEPHONE & POSTAGE", LookAt:=xlWhole, SearchFormat:=False).Value = "OTH. TELEPHONES & POSTAGES"
On Error Resume Next
Columns("A").Find(What:="PRINTING & STATIONERY", LookAt:=xlWhole, SearchFormat:=False).Value = "OTH. PRINTING & STATIONERY"
On Error Resume Next
Columns("A").Find(What:="ADMINISTRATION EXPENSES", LookAt:=xlWhole, SearchFormat:=False).Value = "OTH. ADMINISTRATION EXPENSES"
Dim Nams As Variant, n As Variant,
c As Long, oSum(1 To 5) As Double
Dim Rng As Range, Dn As Range, Dic As Object
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Nams = Array("TOTAL OPERATING EXP.", "COST OF SALES", "DIRECT EXPENSES", "FIXED EXPENSES", "ADMINISTRATION EXPENSES", "SUNDRY ACCOUNTS", "SUNDRY INCOME", "SUNDRY EXPENSES", "MISCELLENEOUS")
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
For Each n In Nams: Dic
= Empty: Next
For Each Dn In Rng
If Dic.Exists(Dn.Value) Then
oSum(1) = oSum(1) + Dn.Offset(, 1).Value
oSum(2) = oSum(2) + Dn.Offset(, 3).Value
oSum(3) = oSum(3) + Dn.Offset(, 5).Value
oSum(4) = oSum(4) + Dn.Offset(, 7).Value
oSum(5) = oSum(5) + Dn.Offset(, 9).Value
c = c + 1
End If
If c = Dic.Count Then
With Dn.Offset(1)
.Resize(2).EntireRow.Insert
.Offset(-1).Value = "TOTAL EXPENSES"
.Offset(-1, 1).Value = oSum(1)
.Offset(-1, 3).Value = oSum(2)
.Offset(-1, 5).Value = oSum(3)
.Offset(-1, 7).Value = oSum(4)
.Offset(-1, 9).Value = oSum(5)
End With
Exit Sub
End If
Next Dn
End Sub