I apologize; I never got any notifications for this question. In the meantime I figured it out by just using a few semi-hardcoded lines. I needed to do it for both AM and PM values since my picture shows 1 week of data and while that week doesn't have any AM values, weeks below it do. Here is the code I used:
Code:Sub DMUAMPM() Dim lngLastRow As Long Dim lngRow As Long Dim strAMPM As String Dim strColumn As String Dim intOffset As Integer With Application .EnableEvents = False .ScreenUpdating = False .Calculation = xlCalculationManual End With With ActiveSheet Select Case ActiveCell.Address(0, 0) Case "AU3" strColumn = "AU" strAMPM = "AM" intOffset = -1 Case "AT3" strColumn = "AT" strAMPM = "PM" intOffset = 0 Case Else MsgBox "Please click the DMU PM or DMU AM button" Exit Sub End Select lngLastRow = .Range("L1048576").End(xlUp).Row .Range(strColumn & "5" & ":" & strColumn & lngLastRow).ClearContents For lngRow = 5 To lngLastRow Step 13 .Cells(lngRow + intOffset + 1, strColumn) = .Cells(lngRow + intOffset + 3, "L") & _ .Cells(lngRow + intOffset + 1, "M") .Cells(lngRow + intOffset + 3, strColumn) = .Cells(lngRow + intOffset + 5, "L") & _ .Cells(lngRow + intOffset + 3, "M") & _ .Cells(lngRow + intOffset + 1, "N") .Cells(lngRow + intOffset + 5, strColumn) = .Cells(lngRow + intOffset + 7, "L") & _ .Cells(lngRow + intOffset + 5, "M") & _ .Cells(lngRow + intOffset + 3, "N") & _ .Cells(lngRow + intOffset + 1, "O") .Cells(lngRow + intOffset + 7, strColumn) = .Cells(lngRow + intOffset + 9, "L") & _ .Cells(lngRow + intOffset + 7, "M") & _ .Cells(lngRow + intOffset + 5, "N") & _ .Cells(lngRow + intOffset + 3, "O") .Cells(lngRow + intOffset + 9, strColumn) = .Cells(lngRow + intOffset + 11, "L") & _ .Cells(lngRow + intOffset + 9, "M") & _ .Cells(lngRow + intOffset + 7, "N") & _ .Cells(lngRow + intOffset + 5, "O") .Cells(lngRow + intOffset + 11, strColumn) = .Cells(lngRow + intOffset + 11, "M") & _ .Cells(lngRow + intOffset + 9, "N") & _ .Cells(lngRow + intOffset + 7, "O") Next End With With Application .Calculation = xlCalculationAutomatic .EnableEvents = True .ScreenUpdating = True End With End Sub




Reply With Quote
