Monthly excel VBA report

taeas

New Member
Joined
May 2, 2021
Messages
11
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
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
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAG
1Unit NameForm No.Custom Multiline Field 1Form Template No.Form Template NameCreate DateStatusCountCustom Date Field 1Custom Date Field 2Custom Date Field 3Custom Date Field 4Custom Date Field 5Custom Numeric Field 1Custom Numeric Field 10Custom Numeric Field 2Custom Numeric Field 3Custom Numeric Field 4Custom Numeric Field 5Custom Numeric Field 6Custom Numeric Field 7Custom Numeric Field 8Custom Numeric Field 9Custom Text Field 1Custom Text Field 10Custom Text Field 2Custom Text Field 3Custom Text Field 4Custom Text Field 5Custom Text Field 6Custom Text Field 7Custom Text Field 8Custom Text Field 9
2Aqua TEST19828792-2020-APPCOM007-0512020-135APPCOM007Shipping Letter WB11/1/20Approved110/30/2010/30/2010/30/2010/30/2011/1/20120.150.1515459415545623.623.8310050MOWITransfer SmoltN/AYesYtre standal - bastlid64Closed
3Aqua TEST29828792-2021-APPCOM007-0232021/ 0012APPCOM007Shipping Letter WB1/24/21Approved11/23/211/23/211/23/211/23/211/24/217.50.120.15169612170525340137MOWITransfer SmoltN/AYesSteinsvik til VoldnesM9M10Closed
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
BCDEFGHIJKLMNOPQRSTUVWX
6Month :
7Vessel:
8
9Date Charter Shipping Letter No.:Production AreaSite / Location Harbour Work description Average Weight Fish Loaded Biomass Treated Dead on arrivalOil / Sludge disposal Refuelling Chemical UsedSailing distanceSailing timeTime consumed Comments
10[YYYY-NNN] (P04 etc.)[kg][pcs][ton][pcs][l][l][l][nm][h]Work [h]Harbour [h]Wash [h]Ozonation [h]Veterinarian control Quarantine
11
121/1/210.0
131/2/21
141/3/21
151/4/21
Monthly Report
Cell Formulas
RangeFormula
K12K12=J12*I12/1000


Any help performing this task will be appreciated !
 
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 :confused: 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
 
Upvote 0

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
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.
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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")
??‍♂️
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,223,977
Messages
6,175,753
Members
452,667
Latest member
vanessavalentino83

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top