Create report balances for many customers

Solved
Report
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021
-
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021
-
hi
here this is the first post and I hope find what I'm looking for despite my request is not easy
I have data in sheet1 contains many process and show the customers which paid and unpaid and the sheet2 contains first of balance for some customers what I wand in sheet3 contains dropdown list in b1 when I select the customer should show details as in my picture 3 and if i select another should copy to the bottom and if no select any name should all data for all customers
as you see in b3 first this value should bring from sheet2 if the customer contains that also in row 6 at the same thing and about the balance should the next row is 7 in column e "BALANCE" should be the formula like this balance=first +debit-credit
and the next name doesn't contain first balnce in sheet2 the first in cell b15 should be 0 and there is no first value in row18
sheet1



sheet2




sheet3


I hope to somebody helps me

5 replies

Posts
2829
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 22, 2021
490
Hi Abdomegahri,

In case no one else replies, know that I've seen your query and will prvide assistance once I have the time. I'm helping out someone else at the moment.

Best regards,
Trowa
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021

Hi Trowa,
I appreciate your interesting I will waiting for you when you have time
thanks
Posts
2829
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 22, 2021
490 >
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021

Hi Abdomegahri,

Thanks for your patience.

When looking at your query, wouldn't it be better to create sheet3 for all customers by default. The way you describe it, with selecting another name in the drop downlist in B1 will copy the previous name to the bottom, will create duplicates. When all customer are on sheet3, then you can use Ctrl+f to find a specific customer.

What are your thoughts?

Best regards,
Trowa
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021

Hi, Trowa
I happy to hear you again !
actually I don't want copying the previous name to the bottom, and create duplicates
and I don't search by CTRL+F if do that by macro it will a great I think you can overcome if I select again the same customer by message inform me this customer is existed and ignore copying again to the bottom .
to understand why I ask this way my manager sometime asks me some customers not all so I would this macro is flexible when I search by dropdown whether ALL by add to dropdown or by select name every time.
finally if you see any another way to do that I'm all ears
thanks again
Posts
2829
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 22, 2021
490
Hi Abdomegahri,

Ok, then how about we use column D of Sheet2 to place checkmarks in. I would create 2 buttons. One to check all names (place an "x") and one to uncheck all names. I would also add the functionality to check and uncheck by just clicking the cell, instead of double-clicking the cell, entering the checkmark and hitting enter.

Once all checkmarks are in place and you select Sheet3, a message pops up, asking you to update the sheet based on checkmarks. Clicking No, then nothing happens. Clicking Yes, then the sheet is cleared and recreated based on the checkmarks.

How does that sound?

Best regards,
Trowa
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021
>
Posts
2829
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 22, 2021

Hi,Trowa
if the result shows like my picture in sheet3 I don't mind the choosing way to writing the code you decide it because you know how write the code and the right way but keep in your mind the result should exactly show in sheet3
best regards,
abdomegahri
Posts
2829
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 22, 2021
490 >
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021

Hi Abdomegahri,

Wanting to show you how the result looks, to see how you like it. Let me know what you like to see adjusted.



Best regards,
Trowa
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021
>
Posts
2829
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 22, 2021

Hi Trowa,
yes , exactly this is what I want but if the customer there is no first balance I suppose your code shows 0
best regards ,
abdomegahri
Posts
2829
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 22, 2021
490 >
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021

Hi Abdomegahri,

Well, when there is no first balance, you don't want to see that row and the first item will be 2. So that is what you'll get :).

Best regards,
Trowa
Posts
2829
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 22, 2021
490
Hi Abdomegahri,

There are a number of codes that need to be placed in either a standard module, sheet2 or sheet3.

Let's start with the standard module:
Sub CreateReport()
Dim mName As String
Dim mFB, mDeb, mCred As Currency
Dim Header1 As Variant, Header2 As Variant
Dim lRow, lRow2, x, y As Long
Dim mFind As Range
Dim sFB As Boolean

Application.EnableEvents = False
Application.ScreenUpdating = False

Range("A1:G" & Range("A" & Rows.Count).End(xlUp).Row).Delete shift:=xlUp

Header1 = Array("Name", "First Balance", "Debit", "Credit", "Balance")
Header2 = Array("Item", "Date", "Debit", "Credit", "Balance", "Case", "Describe")

Sheets("Sheet2").Select

For Each cell In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    If cell.Offset(0, 2).Value = "x" Then
        mName = cell.Value
        mFB = cell.Offset(0, 1).Value
        
        With Sheets("Sheet3")
            lRow = .Range("A" & Rows.Count).End(xlUp).Row + 5
            lRow2 = lRow + 3
            .Select
            
            With .Range(Cells(lRow, "A"), Cells(lRow, "E"))
                .Value = Header1
                .Font.Bold = True
                .Interior.ColorIndex = 15
            End With
            
            With .Range(Cells(lRow, "A"), Cells(lRow + 1, "E"))
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                .Borders(xlInsideVertical).LineStyle = xlContinuous
            End With
            
            With .Range(Cells(lRow2, "A"), Cells(lRow2, "G"))
                .Value = Header2
                .Font.Bold = True
                .Interior.ColorIndex = 15
            End With
            
            Set mFind = Sheets("Sheet1").Range("D4:D" & Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row).Find(mName)
            firstAddress = mFind.Address
            x = x + 1
            
            If mFB <> 0 Then
                lRow2 = lRow2 + 1
                .Range("A" & lRow2).Value = x
                .Range("E" & lRow2).Value = mFB
                .Range("G" & lRow2).Value = "First Balance"
            End If
            
            Do
                lRow2 = lRow2 + 1
                x = x + 1
                .Range("A" & lRow2).Value = x
                .Range("B" & lRow2).Value = mFind.Offset(0, -3).Value
                .Range("C" & lRow2).Value = mFind.Offset(0, -2).Value
                .Range("D" & lRow2).Value = mFind.Offset(0, -1).Value
                .Range("F" & lRow2).Value = mFind.Offset(0, 1).Value
                .Range("G" & lRow2).Value = mFind.Offset(0, 2).Value
                Set mFind = Sheets("Sheet1").Range("D4:D" & Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row).FindNext(mFind)
            Loop While mFind.Address <> firstAddress

            If mFB = 0 Then
                x = x - 1
                sFB = True
            End If
            
            lRow2 = lRow2 - x
            y = x
            
            Do
                y = y - 1
                lRow2 = lRow2 + 1
                If .Range("E" & lRow2).Value = 0 And sFB = True Then
                    .Range("E" & lRow2).Value = .Range("C" & lRow2).Value - .Range("D" & lRow2).Value
                    sFB = False
                ElseIf .Range("E" & lRow2).Value = 0 Then
                    .Range("E" & lRow2).Value = .Range("E" & lRow2 - 1).Value + .Range("C" & lRow2).Value - .Range("D" & lRow2).Value
                End If
            Loop Until y = 0
            
            With .Range(.Cells(lRow2 - x, "A"), .Cells(lRow2, "G"))
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                .Borders(xlInsideVertical).LineStyle = xlContinuous
            End With
            
            mDeb = Application.WorksheetFunction.Sum(.Range(.Cells(lRow2 + 1 - x, "C"), .Cells(lRow2, "C")))
            mCred = Application.WorksheetFunction.Sum(.Range(.Cells(lRow2 + 1 - x, "D"), .Cells(lRow2, "D")))
            .Range("A" & lRow + 1).Value = mName
            .Range("B" & lRow + 1).Value = mFB
            .Range("C" & lRow + 1).Value = mDeb
            .Range("C" & lRow + 1).NumberFormat = "[$€-2] #,##0.00"
            .Range("D" & lRow + 1).Value = mCred
            .Range("E" & lRow + 1).Value = .Range("E" & lRow2).Value
            x = 0
        End With
    End If
Next cell

With Columns("A:G")
    .EntireColumn.AutoFit
    .HorizontalAlignment = xlCenter
End With

Range("A1:G5").Delete shift:=xlUp

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Sub xAddAll()
For Each cell In Range("D2:D" & Range("B" & Rows.Count).End(xlUp).Row)
    cell.Value = "x"
Next cell
End Sub

Sub xRemoveAll()
Range("D2:D" & Range("B" & Rows.Count).End(xlUp).Row).ClearContents
End Sub


Then the codes for sheet2:
Private Sub CommandButton1_Click()
Call xAddAll
End Sub

Private Sub CommandButton2_Click()
Call xRemoveAll
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Columns("D")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "x" Then
    Target.Value = vbNullString
Else
    Target.Value = "x"
End If
End Sub


And finally the code for sheet3:
Private Sub Worksheet_Activate()
Dim qUpdate As Integer
qUpdate = MsgBox("Would you like to update the report?", vbYesNo)
If qUpdate = vbYes Then Call CreateReport
End Sub


Now you can add 2 buttons on sheet2. One is for adding an "x" in column D for all names and one to remove them all. Simply click a cell in column D to add or remove a single "x". Once the "x"'s are in place, select sheet3 and a message pops up, asking to update the report. Click Yes to update or No if you still want to see what is currently on the sheet.

Hopefully it is to your liking.

Best regards,
Trowa
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021

Hi Trowa ,
thanks and I appreciate your assistance , actually I follow your steps but unfortunately it gives me error "Object variable or With block variable not set" in this line
firstAddress = mFind.Address

this is my file
https://www.mediafire.com/file/3v45fwnb0hyk1sq/as.xlsm/file
Posts
2829
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 22, 2021
490 >
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021

Hi Abdomegahri,

Thanks for posting your file. I missed the fact that sheet1 has the item numbers in column A as well. In your first post, the screenshot of sheet1 has the names in the 4th column and I didn't look at the column letter. The code tries to find names in column D, while they are in column E.

So a small adjustment needs to be made:
  • Code line 50:

Set mFind = Sheets("Sheet1").Range("D4:D" & Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row).Find(mName)

should be:
Set mFind = Sheets("Sheet1").Range("E4:E" & Sheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row).Find(mName)
  • Code line 70:

Set mFind = Sheets("Sheet1").Range("D4:D" & Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row).FindNext(mFind)

should be:
Set mFind = Sheets("Sheet1").Range("E4:E" & Sheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row).FindNext(mFind)


Sorry for the inconvenience.

Best regards,
Trowa
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021
>
Posts
2829
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 22, 2021

Hi Trowa,
that's a great ! many thanks just I want if it's possible add another choice by tool checkbox , sometimes some customers pay the whole value then the balance equals 0 , so I would only show the customers which have the balance doesn't equal 0 if I select checkbox then ignore the customers has balance 0
Posts
2829
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 22, 2021
490 >
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021

Hi Abdomegahri,

So you mean to add another button on sheet2 to add an "x" in column D for the customers whose balance isn't 0?

The following code will do that:
Sub xAddFBs()
Range("D2:D" & Range("B" & Rows.Count).End(xlUp).Row).ClearContents
For Each cell In Range("C2:C" & Range("B" & Rows.Count).End(xlUp).Row)
    If cell.Value <> 0 Then cell.Offset(0, 1).Value = "x"
Next cell
End Sub


Best regards,
Trowa
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021

Hi Trowa,
sorry if I don't explain clearly I would that in sheet3 after show all the customers then delete the customer contain the balance is 0 in COl E
Posts
2829
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 22, 2021
490
Hi Abdomegahri,

Ok, for that I adjusted the CreateReport code.

Declare an extra variable at the top:
Dim qRemoveB0 As Integer


And add the following before the End Sub line (last line of the code):
qRemoveB0 = MsgBox("Would you like to remove the customers with zero balance?", vbYesNo)
If qRemoveB0 = vbYes Then
    For x = lRow2 To 1 Step -1
        If Range("E" & x).Value = "Balance" And Range("E" & x + 1).Value = 0 Then
            lRow = Range("A" & x + 3).End(xlDown).Row + 4
            Range(Cells(x, "A"), Cells(lRow, "G")).Delete
        End If
    Next x
End If


Once you decide to update the report, an extra question is asked to remove the customers with a balance of zero.

Best regards,
Trowa
Posts
10
Registration date
Wednesday March 3, 2021
Status
Member
Last seen
June 7, 2021

Hi Trowa,
this is exactly what I want , well done buddy !