Monthly excel VBA report

taeas · May 2, 2021

Hi

Apologies if this is an so appearantly easy question that preschoolers can do it in their sleet

i have looked but i cant find a good solution.
But the only way i can see is VBA.
Because i cant touch the "Data" sheet, due it will return a bad format in the production system causing the report to crash.
My goal is to return monthly data values from the "data" sheet to the predefined template set by our customer in the "Monthly Report" tab Where the headers have comment on what data field in "data" that corresponds to the field header.

So the case is: all formulas needs to be defined in the "Monthly Report" sheet, or in VBA.
"Data" Sheet

Copy of Monthly Wellboat log test.xlsx

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

Y

Z

AA

AB

AC

AD

AE

AF

AG

1

Unit Name

Form No.

Custom Multiline Field 1

Form Template No.

Form Template Name

Create Date

Status

Count

Custom Date Field 1

Custom Date Field 2

Custom Date Field 3

Custom Date Field 4

Custom Date Field 5

Custom Numeric Field 1

Custom Numeric Field 10

Custom Numeric Field 2

Custom Numeric Field 3

Custom Numeric Field 4

Custom Numeric Field 5

Custom Numeric Field 6

Custom Numeric Field 7

Custom Numeric Field 8

Custom Numeric Field 9

Custom Text Field 1

Custom Text Field 10

Custom Text Field 2

Custom Text Field 3

Custom Text Field 4

Custom Text Field 5

Custom Text Field 6

Custom Text Field 7

Custom Text Field 8

Custom Text Field 9

2

Aqua TEST1

9828792-2020-APPCOM007-051

2020-135

APPCOM007

Shipping Letter WB

11/1/20

Approved

1

10/30/20

11/1/20

12

0.15

154594

155456

23.6

23.8

310050

MOWI

Transfer Smolt

N/A

Yes

Ytre standal - bastlid

6

4

Closed

3

Aqua TEST2

9828792-2021-APPCOM007-023

2021/ 0012

APPCOM007

Shipping Letter WB

1/24/21

Approved

1

1/23/21

1/24/21

7.5

0.12

0.15

169612

170525

340137

MOWI

Transfer Smolt

N/A

Yes

Steinsvik til Voldnes

M9

M10

Closed

Data

Monthly Report :
Vessel field=Unit Name
Charter=Customfield1
Site/Location=CustomFieldText5
Work Description=CustomFieldText2
Fish Loaded=SUM of CustomFieldNumeric4&5

Copy of Monthly Wellboat log test.xlsx

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

6

Month :

7

Vessel:

8

9

Date

Charter

Shipping Letter No.:

Production Area

Site / Location

Harbour

Work description

Average Weight

Fish Loaded

Biomass Treated

Dead on arrival

Oil / Sludge disposal

Refuelling

Chemical Used

Sailing distance

Sailing time

Time consumed

Comments

10

[YYYY-NNN]

(P04 etc.)

[kg]

[pcs]

[ton]

[pcs]

[l]

[nm]

[h]

Work [h]

Harbour [h]

Wash [h]

Ozonation [h]

Veterinarian control

Quarantine

11

12

1/1/21

0.0

13

1/2/21

14

1/3/21

15

1/4/21

Monthly Report

Cell Formulas
Range	Formula
K12	K12	=J12*I12/1000

Any help performing this task will be appreciated !

taeas · May 5, 2021

Zot said:

I have not tried the code extensively. The parameter you wanted to transfer just few sample and I have not verified if they are transferred right since not all variables you said actually match with your Data sheet.

When you execute GetList, it will create a Vessel sheet for my temporary work such as creating unique list of vessels for Validation List. It can be deleted after you execute 2nd code CompileReport which I did not do in my code yet.

Since you are also have experience in VBA, I believe you can easily modify the code to meet your need. I was not able to iron out the code since too busy with work today and also yesterday.

VBA Code:

Sub GetList()

Dim n As Long, rowReport As Long
Dim colUName As String
Dim FName As Variant
Dim rngUName As Range, rowLast As Range
Dim wsFound As Boolean
Dim ws As Worksheet, wsData As Worksheet, wsReport As Worksheet, wsVessel As Worksheet
Dim wbData As Workbook, wbReport As Workbook

Set wbReport = ActiveWorkbook
Set wsReport = wbReport.Sheets("Sheet1")      ' Change accordingly

' Select Data file
FName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb; *.xml), *.xls; *.xlsx; *.xlsm; *.xlsb; *.xml", _
                                                            Title:="Select a File")
If FName = False Then                          'CANCEL is clicked
    Exit Sub
End If

Application.ScreenUpdating = False

Set wbData = Workbooks.Open(Filename:=FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsData = wbData.Sheets("Sheet1")              ' Change accordingly

Set rowLast = wsData.Range("A" & Rows.Count).End(xlUp)
Set rngUName = wsData.Range("A1", rowLast)

' Copy Vessel Name from wsData into a sheet in wsReport Sheet named Vessel
For Each ws In wbReport.Sheets
    If ws.Name = "Vessel" Then wsFound = True
Next
If Not wsFound Then
    wbReport.Sheets.Add(After:=wsReport).Name = "Vessel"
End If
Set wsVessel = wbReport.Sheets("Vessel")
wsVessel.Range("A1", "A100").ClearContents
rngUName.Copy wsVessel.Range("A1")
wsVessel.Range("B2", "B20").Formula = "=IFERROR(INDEX(A2:A100,MATCH(0,INDEX(COUNTIF($B$1:B1,A2:A100),),0)),"""")"
wsReport.Range("D6") = Format(wsReport.Range("B12"), "mmm-yyyy")
wsReport.Range("D7").Validation.Delete
wsReport.Range("D7").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=OFFSET(Vessel!$B$2,,,COUNTIF(Vessel!$B$2:$B$20,""?*""))"
wsVessel.Range("D2") = FName

End Sub

Sub CompileReport()

Dim n As Long, rowReport As Long
Dim colUName As String, colCF1 As String, colCTF2 As String, colCTF5 As String
Dim colCNF4 As String, colCNF5 As String, Vessel As String
Dim cell As Range, rngUName As Range, rowLast As Range, rngColData As Range, colLast As Range
Dim wsFound As Boolean
Dim ws As Worksheet, wsData As Worksheet, wsReport As Worksheet, wsVessel As Worksheet
Dim wbData As Workbook, wbReport As Workbook

Set wbReport = ActiveWorkbook
Set wsReport = wbReport.Sheets("Sheet1")      ' Change accordingly
Set wsVessel = wbReport.Sheets("Vessel")

Application.ScreenUpdating = False

Set wbData = Workbooks.Open(Filename:=wsVessel.Range("D2"), UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsData = wbData.Sheets("Sheet1")              ' Change accordingly
Set colLast = wsData.Range("A1").End(xlToRight)
Set rngColData = wsData.Range("A1", colLast)
Set rowLast = wsData.Range("A" & Rows.Count).End(xlUp)
Set rngUName = wsData.Range("A1", rowLast)

Vessel = wsReport.Range("D7")
If Vessel = "" Then
    MsgBox "Please select vessel", vbCritical, "SELECT VESSEL"
    End
End If
wsReport.Range("D7").Validation.Delete
wsReport.Range("D7") = Vessel

' Find respective columns
For Each cell In rngColData
    Select Case cell
        Case "Unit Name"
            colUName = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Multiline Field 1"
            colCF1 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Text Field 2"
            colCTF2 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Text Field 5"
            colCTF5 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Numeric Field 4"
            colCNF4 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Numeric Field 5"
            colCNF5 = Split(cell.Address, "$")(1)
            n = n + 1
    End Select
    If n = 6 Then Exit For
Next

' Get last row containing report in wsReport
rowReport = wsReport.Range("B" & Rows.Count).End(xlUp).Row

'wsreport.Range("D7")=
For Each cell In rngUName
    If cell = wsReport.Range("D7") Then
        rowReport = rowReport + 1
        wsReport.Range("C" & rowReport) = wsData.Range(colCF1 & cell.Row)
        wsReport.Range("F" & rowReport) = wsData.Range(colCTF5 & cell.Row)
        wsReport.Range("H" & rowReport) = wsData.Range(colCTF2 & cell.Row)
        wsReport.Range("J" & rowReport).Formula = "=" & wsData.Range(colCNF4 & cell.Row).Address(0, 0) & _
                                                                                    "+" & wsData.Range(colCNF5 & cell.Row).Address(0, 0)
    End If
Next

End Sub

Well you say knowledge, knowledge is 15 + years and rusty, so I'm getting only compile errors

So this is just embarrassing. Have changed the parameters, but now i am only lost. Appreciate if you are able to spell it out for me??

Getting invalid outside procedure:

Set wbData = Workbooks.Open(FileName:=FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsData = wbData.Sheets("Sheet1") ' Change accordingly

Set rowLast = wsData.Range("A" & Rows.Count).End(xlUp)
Set rngUName = wsData.Range("A1", rowLast)

' Copy Vessel Name from wsData into a sheet in wsReport Sheet named Vessel
For Each ws In wbReport.Sheets
If ws.Name = "Sheet1" Then wsFound = True
Next
If Not wsFound Then
wbReport.Sheets.Add(After:=wsReport).Name = "Sheet3"
End If
Set wsVessel = wbReport.Sheets("Sheet1")
wsVessel.Range("A1", "A100").ClearContents
rngUName.Copy wsVessel.Range("A1")
wsVessel.Range("B2", "B20").Formula = "=IFERROR(INDEX(A2:A100,MATCH(0,INDEX(COUNTIF($B$1:B1,A2:A100),),0)),"""")"
wsReport.Range("D6") = Format(wsReport.Range("B12"), "mmm-yyyy")
wsReport.Range("D7").Validation.Delete
wsReport.Range("D7").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=OFFSET(Vessel!$B$2,,,COUNTIF(Vessel!$B$2:$B$20,""?*""))"
wsVessel.Range("D2") = FName

End Sub

Zot · May 5, 2021

It is because you messed up when renaming the sheet Vessel. Let me explain what actually my code do.

A) Open workbook Monthly Report which contains the macro
B) Run GetList. Steps:
1) Program will ask for Data file and set the worksheet as wsData
2) Program looks for sheet called Vessel if they existed before. If not, created the sheet and set it as wsVessel
3) Clear column A of wsVessel of any vessel name
4) Use formula to create unique list of vessel name
5) Put date on wsReport at D6
6) Create Validation list at D7 using unique list on wsVessel starting from B2.
7) Put full path of wsData location at D2 to be able to fetch again it the workbook Data is closed
C) Execution complete

Now you need to select which vessel on validation list and just run CompileReport.
At the end of execution, the Validation List will be removed and replaced with the vessel name you have chosen before.
The wsVessel is no longer needed and I was thinking that you save the file as Monthly Report for that particular vessel.
The wsVessel can be deleted automatically but I did not include in the code.

Then you can run the program again by making the workbook Report as template. For subsequent month, you can just take any report for any particular vessel and run the program again. The new data should continue to add to existing data since you plan the report for a year.

Now I see the drawback:
1) If you skip GetList and run CompileReport straightaway, the program will not be able to define wsData.
2) Running the GetList will force you to select the vessel again which is unnecessary ?. Otherwise, the program should perform what it needs to do.

Now back to you modified code.
You look for Sheet1 and if no Sheet1 is found, then you created Sheet3
You can define Sheet1 as wsVessel.

With my explanation above I think you know why it cause error. I presumed the Sheet1 is where you report is.

Another possible solution is:
When you run the program, it will create report for each vessel on separate sheet/tab.
On subsequent month, running the same workbook Report will continue add the data related to each vessel and add more tab if report for any non- existing vessel.
The workbook will keep growing depending on how many vessel. The file will be huge I guess.

taeas · May 6, 2021

Zot said:
It is because you messed up when renaming the sheet Vessel. Let me explain what actually my code do.

A) Open workbook Monthly Report which contains the macro
B) Run GetList. Steps:
1) Program will ask for Data file and set the worksheet as wsData
2) Program looks for sheet called Vessel if they existed before. If not, created the sheet and set it as wsVessel
3) Clear column A of wsVessel of any vessel name
4) Use formula to create unique list of vessel name
5) Put date on wsReport at D6
6) Create Validation list at D7 using unique list on wsVessel starting from B2.
7) Put full path of wsData location at D2 to be able to fetch again it the workbook Data is closed
C) Execution complete

Now you need to select which vessel on validation list and just run CompileReport.
At the end of execution, the Validation List will be removed and replaced with the vessel name you have chosen before.
The wsVessel is no longer needed and I was thinking that you save the file as Monthly Report for that particular vessel.
The wsVessel can be deleted automatically but I did not include in the code.

Then you can run the program again by making the workbook Report as template. For subsequent month, you can just take any report for any particular vessel and run the program again. The new data should continue to add to existing data since you plan the report for a year.

Now I see the drawback:
1) If you skip GetList and run CompileReport straightaway, the program will not be able to define wsData.
2) Running the GetList will force you to select the vessel again which is unnecessary ?. Otherwise, the program should perform what it needs to do.

Now back to you modified code.
You look for Sheet1 and if no Sheet1 is found, then you created Sheet3
You can define Sheet1 as wsVessel.

With my explanation above I think you know why it cause error. I presumed the Sheet1 is where you report is.

Another possible solution is:
When you run the program, it will create report for each vessel on separate sheet/tab.
On subsequent month, running the same workbook Report will continue add the data related to each vessel and add more tab if report for any non- existing vessel.
The workbook will keep growing depending on how many vessel. The file will be huge I guess.

Thank you, Zot.
Will review your last, thank you for the continued support on this.
I see I messed up in the last msg, tried multiple runs/scenarios.

taeas · May 8, 2021

Zot said:
It is because you messed up when renaming the sheet Vessel. Let me explain what actually my code do.

A) Open workbook Monthly Report which contains the macro
B) Run GetList. Steps:
1) Program will ask for Data file and set the worksheet as wsData
2) Program looks for sheet called Vessel if they existed before. If not, created the sheet and set it as wsVessel
3) Clear column A of wsVessel of any vessel name
4) Use formula to create unique list of vessel name
5) Put date on wsReport at D6
6) Create Validation list at D7 using unique list on wsVessel starting from B2.
7) Put full path of wsData location at D2 to be able to fetch again it the workbook Data is closed
C) Execution complete

Now you need to select which vessel on validation list and just run CompileReport.
At the end of execution, the Validation List will be removed and replaced with the vessel name you have chosen before.
The wsVessel is no longer needed and I was thinking that you save the file as Monthly Report for that particular vessel.
The wsVessel can be deleted automatically but I did not include in the code.

Then you can run the program again by making the workbook Report as template. For subsequent month, you can just take any report for any particular vessel and run the program again. The new data should continue to add to existing data since you plan the report for a year.

Now I see the drawback:
1) If you skip GetList and run CompileReport straightaway, the program will not be able to define wsData.
2) Running the GetList will force you to select the vessel again which is unnecessary ?. Otherwise, the program should perform what it needs to do.

Now back to you modified code.
You look for Sheet1 and if no Sheet1 is found, then you created Sheet3
You can define Sheet1 as wsVessel.

With my explanation above I think you know why it cause error. I presumed the Sheet1 is where you report is.

Another possible solution is:
When you run the program, it will create report for each vessel on separate sheet/tab.
On subsequent month, running the same workbook Report will continue add the data related to each vessel and add more tab if report for any non- existing vessel.
The workbook will keep growing depending on how many vessel. The file will be huge I guess.

I am still able to crash the code?

I have tried changing it in the template:

Sheet1=Data where i try to extract the data from.
Sheet3=JAN where i try to compile the report.

(wsVessel.Range("D2") = FName)Should this line not be D7?

VBA Code:

Sub GetList()

Dim n As Long, rowReport As Long
Dim colUName As String
Dim FName As Variant
Dim rngUName As Range, rowLast As Range
Dim wsFound As Boolean
Dim ws As Worksheet, wsData As Worksheet, wsReport As Worksheet, wsVessel As Worksheet
Dim wbData As Workbook, wbReport As Workbook

Set wbReport = ActiveWorkbook
Set wsReport = wbReport.Sheets("JAN")      ' Change accordingly

' Select Data file
FName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb; *.xml), *.xls; *.xlsx; *.xlsm; *.xlsb; *.xml", _
                                                            Title:="Select a File")
If FName = False Then                          'CANCEL is clicked
    Exit Sub
End If

Application.ScreenUpdating = False

Set wbData = Workbooks.Open(FileName:=FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsData = wbData.Sheets("Data")              ' Change accordingly

Set rowLast = wsData.Range("A" & Rows.Count).End(xlUp)
Set rngUName = wsData.Range("A1", rowLast)

' Copy Vessel Name from wsData into a sheet in wsReport Sheet named JAN
For Each ws In wbReport.Sheets
    If ws.Name = "Vessel" Then wsFound = True
Next
If Not wsFound Then
    wbReport.Sheets.Add(After:=wsReport).Name = "JAN"
End If
Set wsVessel = wbReport.Sheets("JAN")
wsVessel.Range("A1", "A100").ClearContents
rngUName.Copy wsVessel.Range("A1")
wsJAN.Range("B2", "B20").Formula = "=IFERROR(INDEX(A2:A100,MATCH(0,INDEX(COUNTIF($B$1:B1,A2:A100),),0)),"""")"
wsReport.Range("D6") = Format(wsReport.Range("B12"), "mmm-yyyy")
wsReport.Range("D7").Validation.Delete
wsReport.Range("D7").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=OFFSET(Data!$B$2,,,COUNTIF(Data!$B$2:$B$20,""?*""))"
wsVessel.Range("D2") = FName

End Sub

Sub CompileReport()

Dim n As Long, rowReport As Long
Dim colUName As String, colCF1 As String, colCTF2 As String, colCTF5 As String
Dim colCNF4 As String, colCNF5 As String, Vessel As String
Dim cell As Range, rngUName As Range, rowLast As Range, rngColData As Range, colLast As Range
Dim wsFound As Boolean
Dim ws As Worksheet, wsData As Worksheet, wsReport As Worksheet, wsVessel As Worksheet
Dim wbData As Workbook, wbReport As Workbook

Set wbReport = ActiveWorkbook
Set wsReport = wbReport.Sheets("JAN")      ' Change accordingly
Set wsVessel = wbReport.Sheets("JAN")

Application.ScreenUpdating = False

Set wbData = Workbooks.Open(FileName:=wsVessel.Range("D2"), UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsData = wbData.Sheets("Data")              ' Change accordingly
Set colLast = wsData.Range("A1").End(xlToRight)
Set rngColData = wsData.Range("A1", colLast)
Set rowLast = wsData.Range("A" & Rows.Count).End(xlUp)
Set rngUName = wsData.Range("A1", rowLast)

Vessel = wsReport.Range("D7")
If Vessel = "" Then
    MsgBox "Please select vessel", vbCritical, "SELECT VESSEL"
    End
End If
wsReport.Range("D7").Validation.Delete
wsReport.Range("D7") = Vessel

' Find respective columns
For Each cell In rngColData
    Select Case cell
        Case "Unit Name"
            colUName = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Multiline Field 1"
            colCF1 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Text Field 2"
            colCTF2 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Text Field 5"
            colCTF5 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Numeric Field 4"
            colCNF4 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Numeric Field 5"
            colCNF5 = Split(cell.Address, "$")(1)
            n = n + 1
    End Select
    If n = 6 Then Exit For
Next

' Get last row containing report in wsReport
rowReport = wsReport.Range("B" & Rows.Count).End(xlUp).Row

'wsreport.Range("D7")=
For Each cell In rngUName
    If cell = wsReport.Range("D7") Then
        rowReport = rowReport + 1
        wsReport.Range("C" & rowReport) = wsData.Range(colCF1 & cell.Row)
        wsReport.Range("F" & rowReport) = wsData.Range(colCTF5 & cell.Row)
        wsReport.Range("H" & rowReport) = wsData.Range(colCTF2 & cell.Row)
        wsReport.Range("J" & rowReport).Formula = "=" & wsData.Range(colCNF4 & cell.Row).Address(0, 0) & _
                                                                                    "+" & wsData.Range(colCNF5 & cell.Row).Address(0, 0)
    End If
Next

End Sub

Zot · May 8, 2021

As I previously mentioned, the wsVessel created in wbReport is just for temporary scratch sheet to create unique list for Validation List and also the remember where the location of the data workbook wsData. No need to care about it at all. In fact you can delete then after compilation is done. The wsVessel.Range("D2") is to remember the wbData location and nothing to do with compilation. So, you modified it wrongly. No need to do anything on line related to wsVessel.

Try copy and run this code:

VBA Code:

Sub GetList()

Dim n As Long, rowReport As Long
Dim colUName As String
Dim FName As Variant
Dim rngUName As Range, rowLast As Range
Dim wsFound As Boolean
Dim ws As Worksheet, wsData As Worksheet, wsReport As Worksheet, wsVessel As Worksheet
Dim wbData As Workbook, wbReport As Workbook

Set wbReport = ActiveWorkbook
Set wsReport = wbReport.Sheets("JAN")      ' Change accordingly

' Select Data file
FName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb; *.xml), *.xls; *.xlsx; *.xlsm; *.xlsb; *.xml", _
                                                            Title:="Select a File")
If FName = False Then                          'CANCEL is clicked
    Exit Sub
End If

Application.ScreenUpdating = False

Set wbData = Workbooks.Open(Filename:=FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsData = wbData.Sheets("Data")              ' Change accordingly

Set rowLast = wsData.Range("A" & Rows.Count).End(xlUp)
Set rngUName = wsData.Range("A1", rowLast)

' Copy Vessel Name from wsData into wbReport sheet Vessel
For Each ws In wbReport.Sheets
    If ws.Name = "Vessel" Then wsFound = True
Next
If Not wsFound Then
    wbReport.Sheets.Add(After:=wsReport).Name = "Vessel"
End If
Set wsVessel = wbReport.Sheets("Vessel")
wsVessel.Range("A1", "A100").ClearContents
rngUName.Copy wsVessel.Range("A1")
wsJAN.Range("B2", "B20").Formula = "=IFERROR(INDEX(A2:A100,MATCH(0,INDEX(COUNTIF($B$1:B1,A2:A100),),0)),"""")"
wsReport.Range("D6") = Format(wsReport.Range("B12"), "mmm-yyyy")
wsReport.Range("D7").Validation.Delete
wsReport.Range("D7").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=OFFSET(Data!$B$2,,,COUNTIF(Data!$B$2:$B$20,""?*""))"
wsVessel.Range("D2") = FName

End Sub

Sub CompileReport()

Dim n As Long, rowReport As Long
Dim colUName As String, colCF1 As String, colCTF2 As String, colCTF5 As String
Dim colCNF4 As String, colCNF5 As String, Vessel As String
Dim cell As Range, rngUName As Range, rowLast As Range, rngColData As Range, colLast As Range
Dim wsFound As Boolean
Dim ws As Worksheet, wsData As Worksheet, wsReport As Worksheet, wsVessel As Worksheet
Dim wbData As Workbook, wbReport As Workbook

Set wbReport = ActiveWorkbook
Set wsReport = wbReport.Sheets("JAN")      ' Change accordingly
Set wsVessel = wbReport.Sheets("Vessel")

Application.ScreenUpdating = False

Set wbData = Workbooks.Open(Filename:=wsVessel.Range("D2"), UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsData = wbData.Sheets("Data")              ' Change accordingly
Set colLast = wsData.Range("A1").End(xlToRight)
Set rngColData = wsData.Range("A1", colLast)
Set rowLast = wsData.Range("A" & Rows.Count).End(xlUp)
Set rngUName = wsData.Range("A1", rowLast)

Vessel = wsReport.Range("D7")
If Vessel = "" Then
    MsgBox "Please select vessel", vbCritical, "SELECT VESSEL"
    End
End If
wsReport.Range("D7").Validation.Delete
wsReport.Range("D7") = Vessel

' Find respective columns
For Each cell In rngColData
    Select Case cell
        Case "Unit Name"
            colUName = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Multiline Field 1"
            colCF1 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Text Field 2"
            colCTF2 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Text Field 5"
            colCTF5 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Numeric Field 4"
            colCNF4 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Numeric Field 5"
            colCNF5 = Split(cell.Address, "$")(1)
            n = n + 1
    End Select
    If n = 6 Then Exit For
Next

' Get last row containing report in wsReport
rowReport = wsReport.Range("B" & Rows.Count).End(xlUp).Row

'wsreport.Range("D7")=
For Each cell In rngUName
    If cell = wsReport.Range("D7") Then
        rowReport = rowReport + 1
        wsReport.Range("C" & rowReport) = wsData.Range(colCF1 & cell.Row)
        wsReport.Range("F" & rowReport) = wsData.Range(colCTF5 & cell.Row)
        wsReport.Range("H" & rowReport) = wsData.Range(colCTF2 & cell.Row)
        wsReport.Range("J" & rowReport).Formula = "=" & wsData.Range(colCNF4 & cell.Row).Address(0, 0) & _
                                                                                    "+" & wsData.Range(colCNF5 & cell.Row).Address(0, 0)
    End If
Next

End Sub

taeas · May 9, 2021

Zot said:

As I previously mentioned, the wsVessel created in wbReport is just for temporary scratch sheet to create unique list for Validation List and also the remember where the location of the data workbook wsData. No need to care about it at all. In fact you can delete then after compilation is done. The wsVessel.Range("D2") is to remember the wbData location and nothing to do with compilation. So, you modified it wrongly. No need to do anything on line related to wsVessel.

Try copy and run this code:

VBA Code:

Sub GetList()

Dim n As Long, rowReport As Long
Dim colUName As String
Dim FName As Variant
Dim rngUName As Range, rowLast As Range
Dim wsFound As Boolean
Dim ws As Worksheet, wsData As Worksheet, wsReport As Worksheet, wsVessel As Worksheet
Dim wbData As Workbook, wbReport As Workbook

Set wbReport = ActiveWorkbook
Set wsReport = wbReport.Sheets("JAN")      ' Change accordingly

' Select Data file
FName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb; *.xml), *.xls; *.xlsx; *.xlsm; *.xlsb; *.xml", _
                                                            Title:="Select a File")
If FName = False Then                          'CANCEL is clicked
    Exit Sub
End If

Application.ScreenUpdating = False

Set wbData = Workbooks.Open(Filename:=FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsData = wbData.Sheets("Data")              ' Change accordingly

Set rowLast = wsData.Range("A" & Rows.Count).End(xlUp)
Set rngUName = wsData.Range("A1", rowLast)

' Copy Vessel Name from wsData into wbReport sheet Vessel
For Each ws In wbReport.Sheets
    If ws.Name = "Vessel" Then wsFound = True
Next
If Not wsFound Then
    wbReport.Sheets.Add(After:=wsReport).Name = "Vessel"
End If
Set wsVessel = wbReport.Sheets("Vessel")
wsVessel.Range("A1", "A100").ClearContents
rngUName.Copy wsVessel.Range("A1")
wsJAN.Range("B2", "B20").Formula = "=IFERROR(INDEX(A2:A100,MATCH(0,INDEX(COUNTIF($B$1:B1,A2:A100),),0)),"""")"
wsReport.Range("D6") = Format(wsReport.Range("B12"), "mmm-yyyy")
wsReport.Range("D7").Validation.Delete
wsReport.Range("D7").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=OFFSET(Data!$B$2,,,COUNTIF(Data!$B$2:$B$20,""?*""))"
wsVessel.Range("D2") = FName

End Sub

Sub CompileReport()

Dim n As Long, rowReport As Long
Dim colUName As String, colCF1 As String, colCTF2 As String, colCTF5 As String
Dim colCNF4 As String, colCNF5 As String, Vessel As String
Dim cell As Range, rngUName As Range, rowLast As Range, rngColData As Range, colLast As Range
Dim wsFound As Boolean
Dim ws As Worksheet, wsData As Worksheet, wsReport As Worksheet, wsVessel As Worksheet
Dim wbData As Workbook, wbReport As Workbook

Set wbReport = ActiveWorkbook
Set wsReport = wbReport.Sheets("JAN")      ' Change accordingly
Set wsVessel = wbReport.Sheets("Vessel")

Application.ScreenUpdating = False

Set wbData = Workbooks.Open(Filename:=wsVessel.Range("D2"), UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsData = wbData.Sheets("Data")              ' Change accordingly
Set colLast = wsData.Range("A1").End(xlToRight)
Set rngColData = wsData.Range("A1", colLast)
Set rowLast = wsData.Range("A" & Rows.Count).End(xlUp)
Set rngUName = wsData.Range("A1", rowLast)

Vessel = wsReport.Range("D7")
If Vessel = "" Then
    MsgBox "Please select vessel", vbCritical, "SELECT VESSEL"
    End
End If
wsReport.Range("D7").Validation.Delete
wsReport.Range("D7") = Vessel

' Find respective columns
For Each cell In rngColData
    Select Case cell
        Case "Unit Name"
            colUName = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Multiline Field 1"
            colCF1 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Text Field 2"
            colCTF2 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Text Field 5"
            colCTF5 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Numeric Field 4"
            colCNF4 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Numeric Field 5"
            colCNF5 = Split(cell.Address, "$")(1)
            n = n + 1
    End Select
    If n = 6 Then Exit For
Next

' Get last row containing report in wsReport
rowReport = wsReport.Range("B" & Rows.Count).End(xlUp).Row

'wsreport.Range("D7")=
For Each cell In rngUName
    If cell = wsReport.Range("D7") Then
        rowReport = rowReport + 1
        wsReport.Range("C" & rowReport) = wsData.Range(colCF1 & cell.Row)
        wsReport.Range("F" & rowReport) = wsData.Range(colCTF5 & cell.Row)
        wsReport.Range("H" & rowReport) = wsData.Range(colCTF2 & cell.Row)
        wsReport.Range("J" & rowReport).Formula = "=" & wsData.Range(colCNF4 & cell.Row).Address(0, 0) & _
                                                                                    "+" & wsData.Range(colCNF5 & cell.Row).Address(0, 0)
    End If
Next

End Sub

Hi Zot.
Tried to just copy & Paste code in, return two error codes:
1: GETLIST: Runtime 1004 - When i try to debug it refers to:
FName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb; *.xml), *.xls; *.xlsx; *.xlsm; *.xlsb; *.xml", _
Title:="Select a File")
2:CompileReport:Runtime error 9 - Subscript out of range. - Debug points towards this line: Set wsVessel = wbReport.Sheets("Vessel")
??‍

Zot · May 9, 2021

taeas said:
Hi Zot.
Tried to just copy & Paste code in, return two error codes:
1: GETLIST: Runtime 1004 - When i try to debug it refers to:
FName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb; *.xml), *.xls; *.xlsx; *.xlsm; *.xlsb; *.xml", _
Title:="Select a File")
2:CompileReport:Runtime error 9 - Subscript out of range. - Debug points towards this line: Set wsVessel = wbReport.Sheets("Vessel")
??‍

Maybe it has something to do with Excel 365. You are running WIndows or Mac? Mine is just 2016 and no such problem. I have no 365 to test

Zot · May 9, 2021

Hi @taeas

As I reached office today, I tested the code again. My fault, the code you modified messed up more than I what I have corrected. I did not have sample file I created at home and did not test it.

At first I thought it was something to do with Excel but now I think it is not. I have tested the code below with workbook Report (wbReport) I created like the one you created in the beginning. I also created a workbook data (wbData).

Now I modified the code to declare your sheet JAN as wsReport. The wbData will have a sheet called Data as defined by your. Give this a try again. I hope no more error.

Here is how I operated:
1) Open wbReport (which contains the 2 macros.
2) Run GetList and select the wbData.
At this stage you will see additional sheet called Vessel. This is just additional sheet I created to to be as source for Validation Data on wsJAN @ range D7. The wbData is still opened together with wbReport.
3) Goto wsJAN range D7 to select which vessel to compile.
4) Run CompileReport.
At this stage you see that the wsJAN range D7 will no longer a validation but just normal cell with vessel you selected. The wbData is closed without saving and the wsVessel is deleted.
You can SaveAs this file before run GetList again for next compilation.

VBA Code:

Sub GetList()

Dim n As Long, rowReport As Long
Dim colUName As String
Dim FName As Variant
Dim rngUName As Range, rowLast As Range
Dim wsFound As Boolean
Dim ws As Worksheet, wsData As Worksheet, wsReport As Worksheet, wsVessel As Worksheet
Dim wbData As Workbook, wbReport As Workbook

Set wbReport = ActiveWorkbook
Set wsReport = wbReport.Sheets("JAN")      ' Change accordingly

' Select Data file
FName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb; *.xml), *.xls; *.xlsx; *.xlsm; *.xlsb; *.xml", _
                                                            Title:="Select a File")
If FName = False Then                          'CANCEL is clicked
    Exit Sub
End If

Application.ScreenUpdating = False

Set wbData = Workbooks.Open(Filename:=FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsData = wbData.Sheets("Data")              ' Change accordingly
wsData.Activate

Set rowLast = wsData.Range("A" & Rows.Count).End(xlUp)
Set rngUName = wsData.Range("A2", rowLast)

' Copy Vessel Name from wsData into wbReport sheet Vessel
For Each ws In wbReport.Sheets
    If ws.Name = "Vessel" Then wsFound = True
Next
If Not wsFound Then
    wbReport.Sheets.Add(After:=wsReport).Name = "Vessel"
End If
Set wsVessel = wbReport.Sheets("Vessel")
wsVessel.Range("A1", "A100").ClearContents
rngUName.Copy wsVessel.Range("A1")
wsVessel.Range("B2", "B20").Formula = "=IFERROR(INDEX(A1:A100,MATCH(0,INDEX(COUNTIF($B$1:B1,A1:A100),),0)),"""")"
wsReport.Range("D6") = Format(wsReport.Range("B12"), "mmm-yyyy")
wsReport.Range("D7").Validation.Delete
wsReport.Range("D7").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=OFFSET(Vessel!$B$2,,,COUNTIF(Vessel!$B$2:$B$20,""?*""))"
wsVessel.Range("D2") = FName

End Sub

Sub CompileReport()

Dim n As Long, rowReport As Long
Dim colUName As String, colCF1 As String, colCTF2 As String, colCTF5 As String
Dim colCNF4 As String, colCNF5 As String, Vessel As String
Dim cell As Range, rngUName As Range, rowLast As Range, rngColData As Range, colLast As Range
Dim wsFound As Boolean
Dim wsData As Worksheet, wsReport As Worksheet, wsVessel As Worksheet
Dim wbData As Workbook, wbReport As Workbook

Set wbReport = ActiveWorkbook
Set wsReport = wbReport.Sheets("JAN")      ' Change accordingly
Set wsVessel = wbReport.Sheets("Vessel")

Application.ScreenUpdating = False

Set wbData = Workbooks.Open(Filename:=wsVessel.Range("D2"), UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsData = wbData.Sheets("Data")              ' Change accordingly
Set colLast = wsData.Range("A1").End(xlToRight)
Set rngColData = wsData.Range("A1", colLast)
Set rowLast = wsData.Range("A" & Rows.Count).End(xlUp)
Set rngUName = wsData.Range("A1", rowLast)

Vessel = wsReport.Range("D7")
If Vessel = "" Then
    MsgBox "Please select vessel", vbCritical, "SELECT VESSEL"
    End
End If
wsReport.Range("D7").Validation.Delete
wsReport.Range("D7") = Vessel

' Find respective columns
For Each cell In rngColData
    Select Case cell
        Case "Unit Name"
            colUName = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Multiline Field 1"
            colCF1 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Text Field 2"
            colCTF2 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Text Field 5"
            colCTF5 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Numeric Field 4"
            colCNF4 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Numeric Field 5"
            colCNF5 = Split(cell.Address, "$")(1)
            n = n + 1
    End Select
    If n = 6 Then Exit For
Next

' Get last row containing report in wsReport
rowReport = wsReport.Range("B" & Rows.Count).End(xlUp).Row
If rowReport < 11 Then rowReport = 11

For Each cell In rngUName
    If cell = wsReport.Range("D7") Then
        rowReport = rowReport + 1
        wsReport.Range("C" & rowReport) = wsData.Range(colCF1 & cell.Row)
        wsReport.Range("F" & rowReport) = wsData.Range(colCTF5 & cell.Row)
        wsReport.Range("H" & rowReport) = wsData.Range(colCTF2 & cell.Row)
        wsReport.Range("J" & rowReport).Formula = "=" & wsData.Range(colCNF4 & cell.Row).Address(0, 0) & _
                                                                                    "+" & wsData.Range(colCNF5 & cell.Row).Address(0, 0)
    End If
Next

Application.DisplayAlerts = False
wsVessel.Delete
Application.DisplayAlerts = True
wbData.Close False

End Sub

taeas · May 15, 2021

Zot said:

Hi @taeas

As I reached office today, I tested the code again. My fault, the code you modified messed up more than I what I have corrected. I did not have sample file I created at home and did not test it.

At first I thought it was something to do with Excel but now I think it is not. I have tested the code below with workbook Report (wbReport) I created like the one you created in the beginning. I also created a workbook data (wbData).

Now I modified the code to declare your sheet JAN as wsReport. The wbData will have a sheet called Data as defined by your. Give this a try again. I hope no more error.

Here is how I operated:
1) Open wbReport (which contains the 2 macros.
2) Run GetList and select the wbData.
At this stage you will see additional sheet called Vessel. This is just additional sheet I created to to be as source for Validation Data on wsJAN @ range D7. The wbData is still opened together with wbReport.
3) Goto wsJAN range D7 to select which vessel to compile.
4) Run CompileReport.
At this stage you see that the wsJAN range D7 will no longer a validation but just normal cell with vessel you selected. The wbData is closed without saving and the wsVessel is deleted.
You can SaveAs this file before run GetList again for next compilation.

VBA Code:

Sub GetList()

Dim n As Long, rowReport As Long
Dim colUName As String
Dim FName As Variant
Dim rngUName As Range, rowLast As Range
Dim wsFound As Boolean
Dim ws As Worksheet, wsData As Worksheet, wsReport As Worksheet, wsVessel As Worksheet
Dim wbData As Workbook, wbReport As Workbook

Set wbReport = ActiveWorkbook
Set wsReport = wbReport.Sheets("JAN")      ' Change accordingly

' Select Data file
FName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb; *.xml), *.xls; *.xlsx; *.xlsm; *.xlsb; *.xml", _
                                                            Title:="Select a File")
If FName = False Then                          'CANCEL is clicked
    Exit Sub
End If

Application.ScreenUpdating = False

Set wbData = Workbooks.Open(Filename:=FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsData = wbData.Sheets("Data")              ' Change accordingly
wsData.Activate

Set rowLast = wsData.Range("A" & Rows.Count).End(xlUp)
Set rngUName = wsData.Range("A2", rowLast)

' Copy Vessel Name from wsData into wbReport sheet Vessel
For Each ws In wbReport.Sheets
    If ws.Name = "Vessel" Then wsFound = True
Next
If Not wsFound Then
    wbReport.Sheets.Add(After:=wsReport).Name = "Vessel"
End If
Set wsVessel = wbReport.Sheets("Vessel")
wsVessel.Range("A1", "A100").ClearContents
rngUName.Copy wsVessel.Range("A1")
wsVessel.Range("B2", "B20").Formula = "=IFERROR(INDEX(A1:A100,MATCH(0,INDEX(COUNTIF($B$1:B1,A1:A100),),0)),"""")"
wsReport.Range("D6") = Format(wsReport.Range("B12"), "mmm-yyyy")
wsReport.Range("D7").Validation.Delete
wsReport.Range("D7").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=OFFSET(Vessel!$B$2,,,COUNTIF(Vessel!$B$2:$B$20,""?*""))"
wsVessel.Range("D2") = FName

End Sub

Sub CompileReport()

Dim n As Long, rowReport As Long
Dim colUName As String, colCF1 As String, colCTF2 As String, colCTF5 As String
Dim colCNF4 As String, colCNF5 As String, Vessel As String
Dim cell As Range, rngUName As Range, rowLast As Range, rngColData As Range, colLast As Range
Dim wsFound As Boolean
Dim wsData As Worksheet, wsReport As Worksheet, wsVessel As Worksheet
Dim wbData As Workbook, wbReport As Workbook

Set wbReport = ActiveWorkbook
Set wsReport = wbReport.Sheets("JAN")      ' Change accordingly
Set wsVessel = wbReport.Sheets("Vessel")

Application.ScreenUpdating = False

Set wbData = Workbooks.Open(Filename:=wsVessel.Range("D2"), UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsData = wbData.Sheets("Data")              ' Change accordingly
Set colLast = wsData.Range("A1").End(xlToRight)
Set rngColData = wsData.Range("A1", colLast)
Set rowLast = wsData.Range("A" & Rows.Count).End(xlUp)
Set rngUName = wsData.Range("A1", rowLast)

Vessel = wsReport.Range("D7")
If Vessel = "" Then
    MsgBox "Please select vessel", vbCritical, "SELECT VESSEL"
    End
End If
wsReport.Range("D7").Validation.Delete
wsReport.Range("D7") = Vessel

' Find respective columns
For Each cell In rngColData
    Select Case cell
        Case "Unit Name"
            colUName = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Multiline Field 1"
            colCF1 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Text Field 2"
            colCTF2 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Text Field 5"
            colCTF5 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Numeric Field 4"
            colCNF4 = Split(cell.Address, "$")(1)
            n = n + 1
        Case "Custom Numeric Field 5"
            colCNF5 = Split(cell.Address, "$")(1)
            n = n + 1
    End Select
    If n = 6 Then Exit For
Next

' Get last row containing report in wsReport
rowReport = wsReport.Range("B" & Rows.Count).End(xlUp).Row
If rowReport < 11 Then rowReport = 11

For Each cell In rngUName
    If cell = wsReport.Range("D7") Then
        rowReport = rowReport + 1
        wsReport.Range("C" & rowReport) = wsData.Range(colCF1 & cell.Row)
        wsReport.Range("F" & rowReport) = wsData.Range(colCTF5 & cell.Row)
        wsReport.Range("H" & rowReport) = wsData.Range(colCTF2 & cell.Row)
        wsReport.Range("J" & rowReport).Formula = "=" & wsData.Range(colCNF4 & cell.Row).Address(0, 0) & _
                                                                                    "+" & wsData.Range(colCNF5 & cell.Row).Address(0, 0)
    End If
Next

Application.DisplayAlerts = False
wsVessel.Delete
Application.DisplayAlerts = True
wbData.Close False

End Sub

Sorry for the late reply, I am on a boat and lost connection to the world. will test and revert. appreciate all your help

Monthly excel VBA report

taeas

New Member

taeas

New Member

Excel Facts

Zot

Well-known Member

taeas

New Member

taeas

New Member

Zot

Well-known Member

taeas

New Member

Zot

Well-known Member

Zot

Well-known Member

taeas

New Member

Similar threads

Forum statistics

Share this page

Monthly excel VBA report

New Member

New Member

Excel Facts

Well-known Member

New Member

New Member

Well-known Member

New Member

Well-known Member

Well-known Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock