1

I'm working on a large data reformatting macro. I'm taking an upload sheet with a variety of data and making a whole new workbook into something that gets sent to external users. I've gotten it pretty close to "click this button to generate," except this last part.

Column F has numbers, maybe duplicates, maybe not. IF column F has duplicates, I want it to sum the corresponding amounts in column G and output in the last (H,#). Then it needs to go to the next data and test for duplicates there. It also will put the borders around it, though that's not the hard part.

It should test from ws1.Range("F5") To ws1.Range("F"& lRow + 5), which is has been identified earlier on.

Because it is pulling lRow from the upload data, that's probably the easiest way to identify the end-point, though lRow +1 will is an empty row. But for summing, there will likely always be data in the next row, so scanning for empty cells doesn't help.

Image of excel sheet

I was trying to do it with a while statement, but I couldn't figure out how to do the 'testing loop' for duplicates as part of the larger scan of the entire table.

Let i = 5
While i < lRow + 5
    If ws1.Cells(i, 6) = ws1.Cells(i + 1, 6) Then
        Let CopyRange = ws1.Cells(i, 7) & ":" & ws1.Cells(i + 1, 7)
        Let PasteRange = ws1.Cells(i + 1, 8)
        ws1.Range(PasteRange).Formula = "=Sum(CopyRange)"
    i = i + 1

    End If
Wend

I'm really not sure the best way to approach.

Thank you for any insight!

Edit:

Here is another link to the most similar problem I've seen, but it's slightly different: Similar

Here is my code, in full, for any review, but it's quite lengthy and this is at the very bottom of it, so I'm not sure it creates any value:

Sub ConvertToFundingRequest()

Dim wb As Workbook, og As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, os As Worksheet, os2 As Worksheet, os3 As Worksheet
Dim lRow As Long, i As Long, endRow As Long, lastSearch1 As Long, lastSearch2 As Long, lastSearch3 As Long, first As Long, last As Long
Dim CopyRange As String, PasteRange As String, searchValue As String



'Create the new workbook
Set og = ThisWorkbook
Set os = og.Worksheets("Upload Sheet")
Set os2 = og.Worksheets("Instructions")
Set os3 = og.Worksheets("Vendors")
Set wb = Workbooks.Add
wb.Worksheets.Add

Application.DisplayAlerts = False
'wb.Sheets("Sheet2").Delete
'wb.Sheets("Sheet3").Delete
Application.DisplayAlerts = True

Set ws1 = wb.Worksheets(1)
Set ws2 = wb.Worksheets(2)

Application.ScreenUpdating = False
ws2.Activate
ActiveWindow.Zoom = 85
ws1.Activate
ActiveWindow.Zoom = 85
Application.ScreenUpdating = True

ws1.Name = "Funding in Total"
ws2.Name = "Funding by Property"

'Format the cells to look like funding request
ws1.Columns("A").ColumnWidth = 38
ws1.Columns("B").ColumnWidth = 55
ws1.Columns("C:E").ColumnWidth = 13
ws1.Columns("F").ColumnWidth = 21
ws1.Columns("G").ColumnWidth = 16
ws1.Columns("H").ColumnWidth = 13
ws1.Columns("I").ColumnWidth = 9
ws1.Rows("1").RowHeight = 27
ws1.Range("A1:B1").Merge
    ws1.Range("A1").Font.Size = 12
    ws1.Range("A1").Font.Name = "Calibri"
    ws1.Range("A1").Font.FontStyle = "Bold"
ws1.Range("C1:G1").Merge
    ws1.Range("C1:G1").Font.Size = 20
    ws1.Range("C1:G1").Font.Name = "Calibri"
    ws1.Range("C1:G1").Font.FontStyle = "Bold"
    ws1.Range("C1:G1").Borders.LineStyle = xlContinuous
    ws1.Range("C1:G1").Borders.Weight = xlMedium
    ws1.Range("C1:G1").HorizontalAlignment = xlCenter
    ws1.Range("C1:G1").Interior.Color = RGB(255, 255, 153)
'Create the table title formatting
    ws1.Range("A4:H4").Font.Underline = xlUnderlineStyleSingle
    ws1.Range("A4:H4").Font.Size = 12
    ws1.Range("A4:H4").Font.Name = "Calibri"
    ws1.Range("A4:H4").Font.FontStyle = "Bold"
    ws1.Range("H3").Font.Size = 12
    ws1.Range("H3").Font.Name = "Calibri"
    ws1.Range("H3").Font.FontStyle = "Bold"

'Create those headers with the formatting
ws1.Cells(1, 1).Value = "Church Street Funding Request " & Format(Now(), "mmmm dd, yyyy")
ws1.Cells(1, 3).Value = "In Total"
ws1.Cells(3, 8).Value = "Invoice"
ws1.Cells(4, 1).Value = "Vendor"
ws1.Cells(4, 2).Value = "Invoice Notes"
ws1.Cells(4, 3).Value = "Property"
ws1.Cells(4, 4).Value = "Date"
ws1.Cells(4, 5).Value = "Account"
ws1.Cells(4, 6).Value = "Invoice Number"
ws1.Cells(4, 7).Value = "Amount"
ws1.Cells(4, 8).Value = "Total"

'Build out data array from original worksheet
lRow = os.Cells(Rows.Count, 1).End(xlUp).Row 'identifies last row to copy data from
'Copy Vendor Codes
Let CopyRange = "C2:C" & lRow + 1
Let PasteRange = "A5:A" & lRow + 5
os3.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ws1.Range(PasteRange).HorizontalAlignment = xlLeft
    ws1.Range(PasteRange).Font.Size = 11
    ws1.Range(PasteRange).Font.Name = "Calibri"
'Copy Invoice Date
Let CopyRange = "E1:E" & lRow
Let PasteRange = "D5:D" & lRow + 5
os.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ws1.Range(PasteRange).HorizontalAlignment = xlLeft
    ws1.Range(PasteRange).Font.Size = 11
    ws1.Range(PasteRange).Font.Name = "Calibri"
    ws1.Range(PasteRange).NumberFormat = "m/d/yyyy;@"
'Copy Invoices Notes
Let CopyRange = "H1:H" & lRow
Let PasteRange = "B5:B" & lRow + 5
os.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ws1.Range(PasteRange).HorizontalAlignment = xlLeft
    ws1.Range(PasteRange).Font.Size = 11
    ws1.Range(PasteRange).Font.Name = "Calibri"
'Copy Property Code
Let CopyRange = "I1:I" & lRow
Let PasteRange = "C5:C" & lRow + 5
os.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ws1.Range(PasteRange).HorizontalAlignment = xlLeft
    ws1.Range(PasteRange).Font.Size = 11
    ws1.Range(PasteRange).Font.Name = "Calibri"
'Copy Invoice Number
Let CopyRange = "G1:G" & lRow
Let PasteRange = "F5:F" & lRow + 5
os.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ws1.Range(PasteRange).HorizontalAlignment = xlLeft
    ws1.Range(PasteRange).Font.Size = 11
    ws1.Range(PasteRange).Font.Name = "Calibri"
'Copy GL Account
Let CopyRange = "K1:K" & lRow
Let PasteRange = "E5:E" & lRow + 5
os.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ws1.Range(PasteRange).HorizontalAlignment = xlLeft
    ws1.Range(PasteRange).Font.Size = 11
    ws1.Range(PasteRange).Font.Name = "Calibri"
    ws1.Range(PasteRange).Replace what:="-", Replacement:="", LookAt:=xlPart, SearchFormat:=False, ReplaceFormat:=False
'Copy Amount
Let CopyRange = "J1:J" & lRow
Let PasteRange = "G5:G" & lRow + 5
os.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ws1.Range(PasteRange).HorizontalAlignment = xlLeft
    ws1.Range(PasteRange).Font.Size = 11
    ws1.Range(PasteRange).Font.Name = "Calibri"
    ws1.Range(PasteRange).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
'Copy Segment
Let CopyRange = "V1:V" & lRow
Let PasteRange = "I5:I" & lRow + 5
os.Range(CopyRange).Copy
ws1.Range(PasteRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Format the bottom part of funding request where the totals are
Let PasteRange = "C" & lRow + 6 & ":F" & lRow + 6
ws1.Range(PasteRange).Merge
    ws1.Range(PasteRange).Font.Size = 14
    ws1.Range(PasteRange).Font.Name = "Calibri"
    ws1.Range(PasteRange).Font.FontStyle = "Bold"
    ws1.Range(PasteRange).Value = "TOTAL VENDOR PAYMENTS"
    ws1.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
    ws1.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
    ws1.Range(PasteRange).Interior.Color = RGB(255, 255, 0)

Let PasteRange = "C" & lRow + 12 & ":F" & lRow + 12
ws1.Range(PasteRange).Merge
    ws1.Range(PasteRange).Font.Size = 14
    ws1.Range(PasteRange).Font.Name = "Calibri"
    ws1.Range(PasteRange).Font.FontStyle = "Bold"
    ws1.Range(PasteRange).Value = "TOTAL TO BE PAID OTHER"
    ws1.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
    ws1.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
    ws1.Range(PasteRange).Interior.Color = RGB(255, 255, 0)

Let PasteRange = "C" & lRow + 15 & ":F" & lRow + 15
ws1.Range(PasteRange).Merge
    ws1.Range(PasteRange).Font.Size = 14
    ws1.Range(PasteRange).Font.Name = "Calibri"
    ws1.Range(PasteRange).Font.FontStyle = "Bold"
    ws1.Range(PasteRange).Value = "TOTAL FUNDING REQUEST"
    ws1.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
    ws1.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlDouble
    ws1.Range(PasteRange).Interior.Color = RGB(255, 255, 0)

Let PasteRange = "B" & lRow + 15 & ":B" & lRow + 15
    ws1.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
    ws1.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlDouble

Let PasteRange = "G" & lRow + 6 'Summing the Amounts
    ws1.Range(PasteRange).Font.Size = 14
    ws1.Range(PasteRange).Font.Name = "Calibri"
    ws1.Range(PasteRange).Font.FontStyle = "Bold"
    ws1.Range(PasteRange).Formula = "=SUM(G5:G" & lRow + 5 & ")"
    ws1.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
    ws1.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
    ws1.Range(PasteRange).Interior.Color = RGB(197, 217, 241)

Let PasteRange = "G" & lRow + 12 'Summing Sales Tax/Other
    ws1.Range(PasteRange).Font.Size = 14
    ws1.Range(PasteRange).Font.Name = "Calibri"
    ws1.Range(PasteRange).Font.FontStyle = "Bold"
    ws1.Range(PasteRange).Formula = "=SUM(G" & lRow + 8 & ":G" & lRow + 10 & ")"
    ws1.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
    ws1.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
    ws1.Range(PasteRange).Interior.Color = RGB(197, 217, 241)
    ws1.Range(PasteRange).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

Let PasteRange = "G" & lRow + 15 'Grand Sum
    ws1.Range(PasteRange).Font.Size = 14
    ws1.Range(PasteRange).Font.Name = "Calibri"
    ws1.Range(PasteRange).Font.FontStyle = "Bold"
    ws1.Range(PasteRange).Formula = "=SUM(G" & lRow + 6 & "+G" & lRow + 12 & ")"
    ws1.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
    ws1.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlDouble
    ws1.Range(PasteRange).Interior.Color = RGB(197, 217, 241)

'This completes all the base formatting for the Funding Request
'''''''''''''''''''''
'Lets start to modify the data. We'll start with the second sheet.

'Again, starting with Formatting
'Format the cells to look like funding request
ws2.Columns("A").ColumnWidth = 38
ws2.Columns("B").ColumnWidth = 55
ws2.Columns("C:E").ColumnWidth = 13
ws2.Columns("F").ColumnWidth = 21
ws2.Columns("G").ColumnWidth = 16
ws2.Rows("1").RowHeight = 27
ws2.Range("A1:B1").Merge
    ws2.Range("A1").Font.Size = 12
    ws2.Range("A1").Font.Name = "Calibri"
    ws2.Range("A1").Font.FontStyle = "Bold"
ws2.Range("C1:G1").Merge
    ws2.Range("C1:G1").Font.Size = 20
    ws2.Range("C1:G1").Font.Name = "Calibri"
    ws2.Range("C1:G1").Font.FontStyle = "Bold"
    ws2.Range("C1:G1").Borders.LineStyle = xlContinuous
    ws2.Range("C1:G1").Borders.Weight = xlMedium
    ws2.Range("C1:G1").HorizontalAlignment = xlCenter
    ws2.Range("C1:G1").Interior.Color = RGB(255, 255, 153)
'Create the table title formatting
    ws2.Range("A3:G3").Font.Underline = xlUnderlineStyleSingle
    ws2.Range("A3:G3").Font.Size = 12
    ws2.Range("A3:G3").Font.Name = "Calibri"
    ws2.Range("A3:G3").Font.FontStyle = "Bold"
    ws2.Range("A3:G3").Borders(xlEdgeBottom).LineStyle = xlContinuous

'Create those headers with the formatting
ws2.Cells(1, 1).Value = "Church Street Funding Request " & Format(Now(), "mmmm dd, yyyy")
ws2.Cells(1, 3).Value = "By Property"
ws2.Cells(3, 1).Value = "Vendor"
ws2.Cells(3, 2).Value = "Invoice Notes"
ws2.Cells(3, 3).Value = "Property"
ws2.Cells(3, 4).Value = "Date"
ws2.Cells(3, 5).Value = "Account"
ws2.Cells(3, 6).Value = "Invoice Number"
ws2.Cells(3, 7).Value = "Amount"

'Copy Data
Let CopyRange = "A5:G" & lRow + 5
Let PasteRange = "A5:G" & lRow + 5
ws1.Range(CopyRange).Copy
ws2.Range(PasteRange).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ws1.Range(PasteRange).HorizontalAlignment = xlLeft
    ws1.Range(PasteRange).Font.Size = 11
    ws1.Range(PasteRange).Font.Name = "Calibri"

'Sort Data
ws2.Range("C4").Value = "Site"
    ws2.Range("A4:G4").AutoFilter
    ws2.AutoFilter.Sort.SortFields. _
        Clear
    ws2.AutoFilter.Sort.SortFields. _
        Add Key:=Range("C4"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ws2.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ws2.Range("A4:G4").AutoFilter
ws2.Range("C4").Value = ""

'Find where -02 ends and label
searchValue = "2350-02"
    With ws2
        endRow = .Cells(Rows.Count, 3).End(xlUp).Row
        For i = 1 To endRow
            If .Cells(i + 4, 3) = searchValue Then
                lastSearch1 = i
            End If
        Next i
    End With

Let PasteRange = lastSearch1 + 5 & ":" & lastSearch1 + 7
ws2.Rows(PasteRange).EntireRow.Insert
Let PasteRange = "B" & lastSearch1 + 6 & ":G" & lastSearch1 + 6
    ws2.Range(PasteRange).Font.Size = 14
    ws2.Range(PasteRange).Font.Name = "Calibri"
    ws2.Range(PasteRange).Font.FontStyle = "Bold"
    ws2.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
    ws2.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
    ws2.Range(PasteRange).Borders(xlEdgeRight).LineStyle = xlContinuous
    ws2.Range(PasteRange).Borders(xlEdgeLeft).LineStyle = xlContinuous
    ws2.Range(PasteRange).Interior.Color = RGB(197, 217, 241)
    Let PasteRange = "B" & lastSearch1 + 6
        ws2.Range(PasteRange).Value = "Total 2350-02"
    Let PasteRange = "G" & lastSearch1 + 6
        ws2.Range(PasteRange).Formula = "=Sum(G5:G" & lastSearch1 + 5 & ")"

'Find where -03 ends and label
searchValue = "2350-03"
    With ws2
        endRow = .Cells(Rows.Count, 3).End(xlUp).Row
        For i = 1 To endRow
            If .Cells(i + lastSearch1 + 7, 3) = searchValue Then
                lastSearch2 = i + lastSearch1 + 7
            End If
        Next i
    End With

Let PasteRange = lastSearch2 + 1 & ":" & lastSearch2 + 3
ws2.Rows(PasteRange).EntireRow.Insert
Let PasteRange = "B" & lastSearch2 + 2 & ":G" & lastSearch2 + 2
    ws2.Range(PasteRange).Font.Size = 14
    ws2.Range(PasteRange).Font.Name = "Calibri"
    ws2.Range(PasteRange).Font.FontStyle = "Bold"
    ws2.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
    ws2.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
    ws2.Range(PasteRange).Borders(xlEdgeRight).LineStyle = xlContinuous
    ws2.Range(PasteRange).Borders(xlEdgeLeft).LineStyle = xlContinuous
    ws2.Range(PasteRange).Interior.Color = RGB(197, 217, 241)
    Let PasteRange = "B" & lastSearch2 + 2
        ws2.Range(PasteRange).Value = "Total 2350-03"
    Let PasteRange = "G" & lastSearch2 + 2
        ws2.Range(PasteRange).Formula = "=Sum(G" & lastSearch1 + 8 & ":G" & lastSearch2 + 1 & ")"

'Find where -04 ends and label
searchValue = "2350-04"
    With ws2
        endRow = .Cells(Rows.Count, 3).End(xlUp).Row
        For i = 1 To endRow
            If .Cells(i + lastSearch2 + 4, 3) = searchValue Then
                lastSearch3 = i + lastSearch2 + 4
            End If
        Next i
    End With

Let PasteRange = lastSearch3 + 1 & ":" & lastSearch3 + 3
ws2.Rows(PasteRange).EntireRow.Insert
Let PasteRange = "B" & lastSearch3 + 2 & ":G" & lastSearch3 + 2
    ws2.Range(PasteRange).Font.Size = 14
    ws2.Range(PasteRange).Font.Name = "Calibri"
    ws2.Range(PasteRange).Font.FontStyle = "Bold"
    ws2.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
    ws2.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
    ws2.Range(PasteRange).Borders(xlEdgeRight).LineStyle = xlContinuous
    ws2.Range(PasteRange).Borders(xlEdgeLeft).LineStyle = xlContinuous
    ws2.Range(PasteRange).Interior.Color = RGB(197, 217, 241)
    Let PasteRange = "B" & lastSearch3 + 2
        ws2.Range(PasteRange).Value = "Total 2350-04"
    Let PasteRange = "G" & lastSearch3 + 2
        ws2.Range(PasteRange).Formula = "=Sum(G" & lastSearch2 + 4 & ":G" & lastSearch3 + 1 & ")"

'Finish off The by Property Tab
Let PasteRange = "A" & lastSearch3 + 4 & ":G" & lastSearch3 + 4
    ws2.Range(PasteRange).Font.Size = 14
    ws2.Range(PasteRange).Font.Name = "Calibri"
    ws2.Range(PasteRange).Font.FontStyle = "Bold"
    ws2.Range(PasteRange).Borders(xlEdgeTop).LineStyle = xlContinuous
    ws2.Range(PasteRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
    ws2.Range(PasteRange).Borders(xlEdgeRight).LineStyle = xlContinuous
    ws2.Range(PasteRange).Borders(xlEdgeLeft).LineStyle = xlContinuous
    ws2.Range(PasteRange).Interior.Color = RGB(197, 217, 241)
    Let PasteRange = "B" & lastSearch3 + 4
        ws2.Range(PasteRange).Value = "Total Funding Request"
    Let PasteRange = "G" & lastSearch3 + 4
        ws2.Range(PasteRange).Formula = "=Sum(G" & lastSearch1 + 6 & " + G" & lastSearch2 + 2 & " + G" & lastSearch3 + 2 & ")"

'The property tab should now be completely formatted (except Sales Tax, which is a manual entry
''''''''''''''''''
'Only thing remaining is to do the combined invoices thing.

Let i = 5
'While i < lRow + 5
    If ws1.Cells(i, 6) = ws1.Cells(i + 1, 6) Then 'And ws1.Cells(i, 6) = ws1.Cells(i + 2, 6) And ws1.Cells(i, 6) = ws1.Cells(i + 3, 6) And _
    'ws1.Cells(i, 6) = ws1.Cells(i + 4, 6) And ws1.Cells(i, 6) = ws1.Cells(i + 5, 6) And ws1.Cells(i, 6) = ws1.Cells(i + 6, 6) And _
    'ws1.Cells(i, 6) = ws1.Cells(i + 7, 6) And ws1.Cells(i, 6) = ws1.Cells(i + 8, 6) And ws1.Cells(i, 6) = ws1.Cells(i + 9, 6) Then
        Let CopyRange = ws1.Cells(i, 7) & ":" & ws1.Cells(i + 1, 7)
        Let PasteRange = ws1.Cells(i + 1, 8)
        ws1.Range(PasteRange).Value = CopyRange
    i = i + 1
'
'    If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
'    If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
'    If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
'    If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
'    If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
'    If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
'    If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then
'    If ws1.Cells(i, 5) = ws1.Cells(i + 1, 5) Then

    End If
'Wend




ws2.Range("Z1").Copy
End Sub

Edit 2: The other post I linked is the process I want, but I would need a follow-up to delete all the non-final values, which include any non-duplicate invoices as well as the first iterations of the duplicates (meaning if it prints 11,518.70 in H5:H10, i'd need to clear H5:H9). I also don't know how I'd format the boxes using this way.

Edit 3:

Here is my partial solution. The only thing this doesn't accomplish (and I don't know how), is to create the boxes around the invoices which belong together.

'Only thing remaining is to do the combined invoices thing.

    With ws1.Range("H5:H" & lRow + 4)
        .ClearContents
        .Value = ws1.Evaluate("INDEX(SUMIF(F5:F" & lRow + 4 & ",F5:F" & lRow + 4 & ",G5:G" & lRow + 4 & "),)")
    End With

    i = 5
    For i = 5 To lRow + 4
        If ws1.Cells(i, 7).Value = ws1.Cells(i, 8).Value Then
            ws1.Cells(i, 8).Value = ""
        End If
    Next i

    i = 5
    For i = 5 To lRow + 4
        If ws1.Cells(i, 8).Value = ws1.Cells(i + 1, 8).Value Then
            ws1.Cells(i, 8).Value = ""
        End If
    Next i
    Let PasteRange = "H5:H" & lRow + 4
    ws1.Range(PasteRange).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Improve this question

1 Answer 1

Reset to default
1

Alright, for anyone who has a similar problem, here was my solution. I created an exhaustive solution set based on if there were duplicate values, and had different border stipulations for each. I'm sure it's not the fastest way, but now I have a deliverable.

'Only thing remaining is to do the combined invoices thing.

With ws1.Range("H5:H" & lRow + 4)
    .ClearContents
    .Value = ws1.Evaluate("INDEX(SUMIF(F5:F" & lRow + 4 & ",F5:F" & lRow + 4 & ",G5:G" & lRow + 4 & "),)")
End With

Let PasteRange = "G5:H" & lRow + 4
ws1.Range(PasteRange).Borders.LineStyle = xlContinuous

i = 5
For i = 5 To lRow + 4
    If ws1.Cells(i, 7).Value = ws1.Cells(i, 8).Value Then
        ws1.Cells(i, 8).Value = ""
        ws1.Cells(i, 8).Borders(xlEdgeBottom).LineStyle = xlNone
        ws1.Cells(i, 8).Borders(xlEdgeRight).LineStyle = xlNone
        ws1.Cells(i, 8).Borders(xlEdgeLeft).LineStyle = xlNone
        ws1.Cells(i, 7).Borders(xlEdgeBottom).LineStyle = xlNone
        ws1.Cells(i, 7).Borders(xlEdgeRight).LineStyle = xlNone
        ws1.Cells(i, 7).Borders(xlEdgeLeft).LineStyle = xlNone
    End If
Next i

i = 5
For i = 5 To lRow + 4
    If ws1.Cells(i, 8).Value = ws1.Cells(i + 1, 8).Value Then
        ws1.Cells(i, 8).Value = ""
        ws1.Cells(i, 8).Borders(xlEdgeBottom).LineStyle = xlNone
        ws1.Cells(i, 7).Borders(xlEdgeBottom).LineStyle = xlNone
        ws1.Cells(i, 8).Borders(xlEdgeLeft).LineStyle = xlNone
        ws1.Cells(i, 7).Borders(xlEdgeRight).LineStyle = xlNone
        ws1.Cells(i + 1, 8).Borders(xlEdgeLeft).LineStyle = xlNone
        ws1.Cells(i + 1, 7).Borders(xlEdgeRight).LineStyle = xlNone
    End If
Next i

i = 5
For i = 5 To lRow + 4
    If ws1.Cells(i, 6).Value <> ws1.Cells(i - 1, 6).Value And ws1.Cells(i, 6).Value = ws1.Cells(i + 1, 6).Value Then
        ws1.Cells(i, 8).Borders(xlEdgeTop).LineStyle = xlContinuous
        ws1.Cells(i, 7).Borders(xlEdgeTop).LineStyle = xlContinuous
    End If
Next i

ws1.Range(PasteRange).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Improve this answer
Sign up to request clarification or add additional context in comments.

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.