Yongle
04-13-2015, 06:37 AM
Background
Event Data, held in a database (over which I have no control), is exported into a single sheet workbook (EventsData.xls, which is ultimately mailmerged into Word after significant macro manipulation to make the data usable. There are several thousand records and 60 columns.
Over the years, the database has been patched to give it additional features, with the result that there are inconsistencies in the data. Events can be either single day or multi-day. But an event may contain one record for several dates (different start and finish dates) or multiple records for a single date (same start and finish dates, but different start finish times etc) or even a combination of both.
The database has just been patched again (so the old difficulties are all still there), EventsData.xls changed shape and obviously macros crashed. I have succeeded in tweaking the old macros to work with the new shape of the data and everything is working. I see this as an opportunity to tidy a few things up now that I remember how everything works!
The macro below
A prior procedure sorts the data by event number and creates a column where the event number is held against each event once in the first row for that event (all other cells in that column blank).
The macro below takes the data from one worksheet and transfers it to another, creating a single row for an event, concatenating all the details for one particular field.
What makes this particularly verbose macro hard to maintain is the single line entry (times by 2 ) for each column that is copied/concatenated. There must be a much more concise way to write this code, so that it can loop through all the columns without having to hard-wire it line by line.
- not all columns from the “before” sheet are copied to the “after” sheet, so I do need to list the columns to be dealt with individually, somewhere in the code. But as for declaring all the constants etc....
- the sequence of the columns in the “after” sheet is irrelevant – so whatever is most efficient is fine
- given that the instruction following "if then" is identical for several lines to that following "else" , I would think that moving things around a little would reduce the duplication.
What I am looking for..
… suggestions for tidying up this macro for easier future maintenance.
There are several further steps necessary in the concatenation process (times, dates, prices etc) and the final worksheet has 49 columns which I do not have any desire to hard-wire!
Thank you, in advance
As a fair exchange for your help, a little tip learned the painful way:
One useful recent change made to the coding that has "bomb-proofed" it a little, was instead of relying on the column numbers to drive the initial pull of the data from EventsData.xls, it now searches for specific row1 text. When new fields were subsequently added to the database, it did not crash anything, even though many columns holding data had changed. Relief!
Sub Consolidate_Times()
Dim CurrentID As String, LastCellInRow As Long, BeforeHRow As Long, AfterHRow As Long
Dim wsBefore As Worksheet, wsAfter As Worksheet
Set wsBefore = Worksheets("TimesWorkings")
Set wsAfter = Worksheets("TimesTable")
' "BEFORE" column headers
Const TimeRangeForSorting = "F"
Const EventIdentifier = "A"
Const Eventmarker = "V"
Const DateRange = "U"
Const TimeRange = "W"
Const EventFirstDay = "AC"
BeforeHRow = 0
' "AFTER" column headers
Const AfterTimeRangeforSorting = "B"
Const AfterEventIdentifier = "A"
Const AfterEventMarker = "Z" '(out of the way to make room for other fields)
Const AfterDateRange = "C"
Const AfterTimeRange = "D"
Const AfterEventFirstDay = "G"
AfterHRow = 0
With wsBefore
CurrentID = .Cells(2, "V").Value
LastCellInRow = .Cells(.Rows.count, "V").End(xlUp).Row
Do While BeforeHRow <= LastCellInRow
BeforeHRow = BeforeHRow + 1
If .Cells(BeforeHRow, "V").Value <> "" Then
AfterHRow = AfterHRow + 1
CurrentID = .Cells(BeforeHRow, "V").Value
wsAfter.Cells(AfterHRow, "Z").Value = CurrentID
wsAfter.Cells(AfterHRow, AfterDateRange).Value = .Cells(BeforeHRow, DateRange).Value
wsAfter.Cells(AfterHRow, AfterTimeRange).Value = .Cells(BeforeHRow, TimeRange).Value
wsAfter.Cells(AfterHRow, AfterTimeRangeforSorting).Value = .Cells(BeforeHRow, TimeRangeForSorting).Value
wsAfter.Cells(AfterHRow, AfterEventFirstDay).Value = .Cells(BeforeHRow, EventFirstDay).Value
wsAfter.Cells(AfterHRow, AfterEventIdentifier).Value = .Cells(BeforeHRow, EventIdentifier).Value
wsAfter.Cells(AfterHRow, AfterEventMarker).Value = .Cells(BeforeHRow, Eventmarker).Value
Else
'SPECIAL LINE = concatenation
wsAfter.Cells(AfterHRow, AfterDateRange).Value = _
wsAfter.Cells(AfterHRow, AfterDateRange).Value & "" & .Cells(BeforeHRow, DateRange).Value
'these are all same as above
wsAfter.Cells(AfterHRow, AfterTimeRange).Value = .Cells(BeforeHRow, TimeRange).Value
wsAfter.Cells(AfterHRow, AfterTimeRangeforSorting).Value = .Cells(BeforeHRow, TimeRangeForSorting).Value
wsAfter.Cells(AfterHRow, AfterEventFirstDay).Value = .Cells(BeforeHRow, EventFirstDay).Value
wsAfter.Cells(AfterHRow, AfterEventIdentifier).Value = .Cells(BeforeHRow, EventIdentifier).Value
wsAfter.Cells(AfterHRow, AfterEventMarker).Value = .Cells(BeforeHRow, Eventmarker).Value
End If
If BeforeHRow = LastCellInRow Then Exit Do
Loop
End With
End Sub
Event Data, held in a database (over which I have no control), is exported into a single sheet workbook (EventsData.xls, which is ultimately mailmerged into Word after significant macro manipulation to make the data usable. There are several thousand records and 60 columns.
Over the years, the database has been patched to give it additional features, with the result that there are inconsistencies in the data. Events can be either single day or multi-day. But an event may contain one record for several dates (different start and finish dates) or multiple records for a single date (same start and finish dates, but different start finish times etc) or even a combination of both.
The database has just been patched again (so the old difficulties are all still there), EventsData.xls changed shape and obviously macros crashed. I have succeeded in tweaking the old macros to work with the new shape of the data and everything is working. I see this as an opportunity to tidy a few things up now that I remember how everything works!
The macro below
A prior procedure sorts the data by event number and creates a column where the event number is held against each event once in the first row for that event (all other cells in that column blank).
The macro below takes the data from one worksheet and transfers it to another, creating a single row for an event, concatenating all the details for one particular field.
What makes this particularly verbose macro hard to maintain is the single line entry (times by 2 ) for each column that is copied/concatenated. There must be a much more concise way to write this code, so that it can loop through all the columns without having to hard-wire it line by line.
- not all columns from the “before” sheet are copied to the “after” sheet, so I do need to list the columns to be dealt with individually, somewhere in the code. But as for declaring all the constants etc....
- the sequence of the columns in the “after” sheet is irrelevant – so whatever is most efficient is fine
- given that the instruction following "if then" is identical for several lines to that following "else" , I would think that moving things around a little would reduce the duplication.
What I am looking for..
… suggestions for tidying up this macro for easier future maintenance.
There are several further steps necessary in the concatenation process (times, dates, prices etc) and the final worksheet has 49 columns which I do not have any desire to hard-wire!
Thank you, in advance
As a fair exchange for your help, a little tip learned the painful way:
One useful recent change made to the coding that has "bomb-proofed" it a little, was instead of relying on the column numbers to drive the initial pull of the data from EventsData.xls, it now searches for specific row1 text. When new fields were subsequently added to the database, it did not crash anything, even though many columns holding data had changed. Relief!
Sub Consolidate_Times()
Dim CurrentID As String, LastCellInRow As Long, BeforeHRow As Long, AfterHRow As Long
Dim wsBefore As Worksheet, wsAfter As Worksheet
Set wsBefore = Worksheets("TimesWorkings")
Set wsAfter = Worksheets("TimesTable")
' "BEFORE" column headers
Const TimeRangeForSorting = "F"
Const EventIdentifier = "A"
Const Eventmarker = "V"
Const DateRange = "U"
Const TimeRange = "W"
Const EventFirstDay = "AC"
BeforeHRow = 0
' "AFTER" column headers
Const AfterTimeRangeforSorting = "B"
Const AfterEventIdentifier = "A"
Const AfterEventMarker = "Z" '(out of the way to make room for other fields)
Const AfterDateRange = "C"
Const AfterTimeRange = "D"
Const AfterEventFirstDay = "G"
AfterHRow = 0
With wsBefore
CurrentID = .Cells(2, "V").Value
LastCellInRow = .Cells(.Rows.count, "V").End(xlUp).Row
Do While BeforeHRow <= LastCellInRow
BeforeHRow = BeforeHRow + 1
If .Cells(BeforeHRow, "V").Value <> "" Then
AfterHRow = AfterHRow + 1
CurrentID = .Cells(BeforeHRow, "V").Value
wsAfter.Cells(AfterHRow, "Z").Value = CurrentID
wsAfter.Cells(AfterHRow, AfterDateRange).Value = .Cells(BeforeHRow, DateRange).Value
wsAfter.Cells(AfterHRow, AfterTimeRange).Value = .Cells(BeforeHRow, TimeRange).Value
wsAfter.Cells(AfterHRow, AfterTimeRangeforSorting).Value = .Cells(BeforeHRow, TimeRangeForSorting).Value
wsAfter.Cells(AfterHRow, AfterEventFirstDay).Value = .Cells(BeforeHRow, EventFirstDay).Value
wsAfter.Cells(AfterHRow, AfterEventIdentifier).Value = .Cells(BeforeHRow, EventIdentifier).Value
wsAfter.Cells(AfterHRow, AfterEventMarker).Value = .Cells(BeforeHRow, Eventmarker).Value
Else
'SPECIAL LINE = concatenation
wsAfter.Cells(AfterHRow, AfterDateRange).Value = _
wsAfter.Cells(AfterHRow, AfterDateRange).Value & "" & .Cells(BeforeHRow, DateRange).Value
'these are all same as above
wsAfter.Cells(AfterHRow, AfterTimeRange).Value = .Cells(BeforeHRow, TimeRange).Value
wsAfter.Cells(AfterHRow, AfterTimeRangeforSorting).Value = .Cells(BeforeHRow, TimeRangeForSorting).Value
wsAfter.Cells(AfterHRow, AfterEventFirstDay).Value = .Cells(BeforeHRow, EventFirstDay).Value
wsAfter.Cells(AfterHRow, AfterEventIdentifier).Value = .Cells(BeforeHRow, EventIdentifier).Value
wsAfter.Cells(AfterHRow, AfterEventMarker).Value = .Cells(BeforeHRow, Eventmarker).Value
End If
If BeforeHRow = LastCellInRow Then Exit Do
Loop
End With
End Sub