WildBurrow
New Member
- Joined
- Apr 5, 2021
- Messages
- 41
- Office Version
- 365
- Platform
- Windows
Below is an outline of what how my books are set up and what the macros accomplish;
Workbook#1: Incident Workbook (IWB) - used to create incident reports. Both macros are in this workbook.
Workbook#2: Master Incident Data Tracker (MIDT) - functions as a summary sheet of all incidents and provides an incident number. Incident numbers are prepopulated in Column "A" and run from 1 through 300 on the "Master" worksheet.
Macro#1 Post to MIDT
If Column "A" of the IWB ("Export") worksheet is blank (no incident number) then
Below are my current macros. I've removed some of the preliminary code (e.g. application.screenupdating = false) to save space.
[/CODE]
I have tried combining the codes but it would either write 400 lines of the same incident data, write nothing, or bug out. I'm sure it has to do with the way I'm address the "If Trim(Master.Cells(j, 1).Value2) = vbNullString Then Exit For" but can't figure out the fix. Any help in pointing me in the right direction will be greatly appreciated.
Workbook#1: Incident Workbook (IWB) - used to create incident reports. Both macros are in this workbook.
Workbook#2: Master Incident Data Tracker (MIDT) - functions as a summary sheet of all incidents and provides an incident number. Incident numbers are prepopulated in Column "A" and run from 1 through 300 on the "Master" worksheet.
Macro#1 Post to MIDT
- Post summary incident information from the incident workbook ("Export") worksheet to the master incident data tracker ("Master") worksheet.
- Obtains an incident number from the MIDT and pastes it in the IWB.
- Uses a previously issued incident number from the incident workbook ("Export") worksheet to match a row of data in the master incident data tracker ("Master") worksheet.
If Column "A" of the IWB ("Export") worksheet is blank (no incident number) then
Find last row of data in MIDT ("Master") worksheet (based on value in Column "B")
Copy/paste values from IWB ("Export") worksheet to the MIDT ("Master") worksheet
Copy the incident number from the MIDT ("Master") worksheet Column "A"
Paste the incident number to the IWB ("Export") worksheet Column "A"
If Column "A" of the IWB ("Export") worksheet is NOT blank (has an incident number) thenMatch IWB ("Export") worksheet Column "A" with MIDT ("Master") worksheet Column "A"
Copy/paste values from IWB ("Export") worksheet the MIDT ("Master") worksheet
Below are my current macros. I've removed some of the preliminary code (e.g. application.screenupdating = false) to save space.
VBA Code:
Sub PostToMIDT()
Dim FileToOpen As Variant, OpenBook As Workbook, ws As Worksheet, strFilePath As String
Set ws1 = ThisWorkbook.ActiveSheet
'Allow user to select applicable MIDT
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File", FileFilter:="Excel Files(*.xls*), *xls*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
'Run macro if file is not open by another user
If OpenBook.ReadOnly = False Then
'Unmerge IWB Incident number before transfer of data
ws1.range("O262:Q262").UnMerge
'Copy Export data to MIDT Master Sheet
ThisWorkbook.worksheets("Export").range("B2:AV2").Copy
OpenBook.Sheets("Master").range("B1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
OpenBook.Sheets("Master").range("B1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
'Copy Incident Number from MIDT
ActiveCell.Offset(0, -1).Copy
'Paste Incident Number to IWB form
ws1.range("O262").PasteSpecial xlPasteValues
'Merge IWB Incident Number fields
ws1.range("O262:Q262").Merge
'Protect MIDT sheet and close file
OpenBook.Sheets("Master").Protect ("Fieldops")
OpenBook.Close True
Else
'Close MIDT and notify user that the file is in use and cannot be accessed
OpenBook.Saved = True
OpenBook.Close
Msgbox "The MIDT is currently open by another User. Please try again later."
Exit Sub
End If
Msgbox "Incident Information has been saved to the MIDT"
End If
If FileToOpen = False Then
Msgbox "You have cancelled the selection process. The MIDT will not be updated"
End If
Sub ExportUpdatedData()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
'Allow user to select applicable MIDT
FileToOpen = Application.GetOpenFilename(Title:="Select Incident Tracking Sheet", FileFilter:="Excel Files(*.xls*), *xls*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
'Run macro if file is not open by another user
Set Master = ThisWorkbook.Sheets("Export Data") 'Incident Workbook (IWB)
Set Slave = OpenBook.Sheets("Master") 'Master Data Tracker Sheet (MDIT)
'Run macro if file is not open by another user
If OpenBook.ReadOnly = False Then
For j = 1 To 400
For i = 1 To 400
If Trim(Master.Cells(j, 1).Value2) = vbNullString Then Exit For
If Master.Cells(j, 1).value = Slave.Cells(i, 1).value Then
Master.Cells(j, 2).Copy 'MDIT Column B (Status) is equal to IWB Column B (Status)...etc.
Slave.Cells(i, 2).PasteSpecial Paste:=xlPasteValues
Master.Cells(j, 3).Copy 'Incident Classification
Slave.Cells(i, 3).PasteSpecial Paste:=xlPasteValues
Master.Cells(j, 4).Copy 'Type of Incident
Slave.Cells(i, 4).PasteSpecial Paste:=xlPasteValues
Master.Cells(j, 5).Copy 'Call Source
Slave.Cells(i, 5).PasteSpecial Paste:=xlPasteValues
End If
Next
Next
OpenBook.Sheets("Master").Protect ("Fieldops")
OpenBook.Close True
Else
'Close MIDT and notify user that the file is in use and cannot be accessed
OpenBook.Saved = True
OpenBook.Close
Msgbox "The MIDT is currently open by another User. Please try again later"
Exit Sub
End If
Msgbox ("The Incident Tracking Sheet has been updated")
End If
If FileToOpen = False Then
Msgbox "You have cancelled the selection process. The MIDT will not be updated"
End If
End If
End Sub
I have tried combining the codes but it would either write 400 lines of the same incident data, write nothing, or bug out. I'm sure it has to do with the way I'm address the "If Trim(Master.Cells(j, 1).Value2) = vbNullString Then Exit For" but can't figure out the fix. Any help in pointing me in the right direction will be greatly appreciated.