Macro to rearrange spreadsheet

[jlister]

Hello
I currently have a spreadsheet that is produced from a reporting system similar to the image below and need to change it to suit my needs. This is currently done manually and takes up too much time.

What I need to do is:

1. Insert a column A with a heading of "Client" - not included in the actual report download
2. Where there is a name e.g., Percy, Gary etc. in Column B or a blank space, the row is to be deleted.
3. The name, e.g. J Philips, G Jones etc. is to be copied to the left of each "Invoice No" under that name.
4. Delete the name in the "Invoice No" column.
5. Convert the number in the "Invoice No" column to number

The resultant spreadsheet should show a name against each invoice number. In some cases, there might be one, and in others up to 4 or 5. (only 3 in the example)

Thank you for any assistance if this is possible.

Regards
John

 

[Michael M]

Can you provide the same info using the xl2BB addin please.
That way we can use the same data . See my tag for the XL2BB download.
Is there already a blank column to the left of the data ??

 

[jlister]

I'll need to do some work on XL2BB as I get an error re open dialog box.
and, no there is not already a blank column to the left. Invoice No. is in cell A1

 

[Cubist]

Try this on a copy.

Sub ReformatSheet()
    Dim ws As Worksheet
    Dim lastCell As Range, DeleteRows As Range
    Dim lastRow As Long
    Dim i As Long
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Set ws = ThisWorkbook.Worksheets("Sheet2") 'Change sheet name as needed
    lastRow = ws.Range("A:D").Find(What:="*", After:=ws.Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, _
                                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    ws.Columns("A").Insert Shift:=xlToRight
    ws.Columns("B").NumberFormat = "0"
    For i = lastRow To 3 Step -1
        If ws.Cells(i, "B").Value = "" Or (Not IsNumeric(ws.Cells(i, "B").Value) And Not IsNumeric(ws.Cells(i - 1, "B").Value)) Then
            ws.Rows(i).Delete
        End If
    Next i
   
    For i = 2 To lastRow
        If Not IsNumeric(ws.Cells(i, "B")) Then
            ws.Cells(i, "A") = ws.Cells(i, "B")
        Else
            ws.Cells(i, "A") = ws.Cells(i - 1, "A")
        End If
    Next i
   
    lastRow = ws.Range("A:E").Find(What:="*", After:=ws.Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, _
                                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set DeleteRows = Nothing
    For i = 1 To lastRow
        If ws.Cells(i, "D").Value = "" Then
            If DeleteRows Is Nothing Then
                Set DeleteRows = ws.Cells(i, "D")
            Else
                Set DeleteRows = Union(DeleteRows, ws.Cells(i, "D"))
            End If
        End If
    Next i
   
    If Not DeleteRows Is Nothing Then
        DeleteRows.EntireRow.Delete
    End If
   
    ws.Range("A1").Value = "Invoice Name"
   
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .CutCopyMode = False
    End With
End Sub

 

[jlister]

Try this on a copy.

Sub ReformatSheet()
    Dim ws As Worksheet
    Dim lastCell As Range, DeleteRows As Range
    Dim lastRow As Long
    Dim i As Long
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Set ws = ThisWorkbook.Worksheets("Sheet2") 'Change sheet name as needed
    lastRow = ws.Range("A:D").Find(What:="*", After:=ws.Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, _
                                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    ws.Columns("A").Insert Shift:=xlToRight
    ws.Columns("B").NumberFormat = "0"
    For i = lastRow To 3 Step -1
        If ws.Cells(i, "B").Value = "" Or (Not IsNumeric(ws.Cells(i, "B").Value) And Not IsNumeric(ws.Cells(i - 1, "B").Value)) Then
            ws.Rows(i).Delete
        End If
    Next i
  
    For i = 2 To lastRow
        If Not IsNumeric(ws.Cells(i, "B")) Then
            ws.Cells(i, "A") = ws.Cells(i, "B")
        Else
            ws.Cells(i, "A") = ws.Cells(i - 1, "A")
        End If
    Next i
  
    lastRow = ws.Range("A:E").Find(What:="*", After:=ws.Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, _
                                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set DeleteRows = Nothing
    For i = 1 To lastRow
        If ws.Cells(i, "D").Value = "" Then
            If DeleteRows Is Nothing Then
                Set DeleteRows = ws.Cells(i, "D")
            Else
                Set DeleteRows = Union(DeleteRows, ws.Cells(i, "D"))
            End If
        End If
    Next i
  
    If Not DeleteRows Is Nothing Then
        DeleteRows.EntireRow.Delete
    End If
  
    ws.Range("A1").Value = "Invoice Name"
  
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .CutCopyMode = False
    End With
End Sub

Thanks Cubist.
I have copied the script but when I run it, I ger "Run-time error '9': Subscript out of range"

 

[Michael M]

Did you change the sheet name from "Sheet2" to your actual sheet name ??

 Set ws = ThisWorkbook.Worksheets("Sheet2") 'Change sheet name as needed

 

[jlister]

Did you change the sheet name from "Sheet2" to your actual sheet name ??

 Set ws = ThisWorkbook.Worksheets("Sheet2") 'Change sheet name as needed

Thanks Cubist.
I have copied the script but when I run it, I ger "Run-time error '9': Subscript out of range"

I changed the sheet number and ran the macro, but the result was not as expected.
It only returned

 

[Cubist]

Your data started in B1 instead of A1.

 

[jlister]

Your data started in B1 instead of A1.

Excellent. Thank you
Much appreciated