Newbie help for a good cause, please

[jeremy466clark]

Hi there. I'm a relative newbie to Excel, and new to this forum, so forgive me if what I'm asking is easy for others. The more straight forward the answers, the easier for me please!!

I am doing voluntary work for a local food aid charity. We need to monitor every client who calls individually, whether they are first time clients (new) or return clients (existing), the number of "heads" in their household (adults, children, babies & pets), and the date of their visit. This will be recorded on Sheet 1 below. Straight forward enough so far.

I then need to summarise all of those numbers per day, per week, and per month, which I'm proposing on Sheet 2 below, and ideally, I want to fully automate this from the data entered on Sheet 1, and that's what I don't know how to do.

So what I need is.......If Column B on Sheet 1 shows N (for new), the figures in Columns C-H on Sheet 1, should be copied to Columns B-G on Sheet 2 under the correct date, based on the date entered in columns J onwards on Sheet 1. If Column B on Sheet 1 shows E (existing client), I need the figures in C-H on Sheet 1 copied to J-O on Sheet 2, again under the correct date, based on the date entered in columns J onwards on Sheet 1.

Just to complicate things further, the first time a client visits, they will obviously be shown as "N" for new, so I'd want their numbers copied to Columns B-G on Sheet 2, but if they call subsequently, they will become Existing (E) clients so any subsequent totals would need to be copied to J-O on Sheet 2.

I've tried to explain things as easily as possible. Hopefully, someone will be able to help

Thanks in advance

Jeremy

 

[mumps]

OK. That will take some more coding. I’ll have a look at it tomorrow.

 

[jeremy466clark]

You're a star. Thank you

 

[mumps]

Click here to download your file. Follow the steps I described previously about deleting the date. The associated data for that date should also be deleted.
This is the revised code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim lCol As Long, sCol As String, lRow As Long, fnd As Range, sCol2 As String
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lCol = Cells(5, Columns.Count).End(xlToLeft).Column
    sCol = Replace(Cells(5, lCol).Address(False, False), "5", "")
    Set fnd = Rows(4).Find("Attendance Dates")
    sCol2 = Replace(Cells(4, fnd.Column).Address(False, False), "4", "")
    Range("A2").ClearContents
    If Intersect(Target, Range(sCol2 & "6:" & sCol & lRow)) Is Nothing Then Exit Sub
    Range("A2") = Target
    CalendarFrm.Show
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    Dim lCol As Long, sCol As String, strDate As String, foundDate As Range, lRow As Long, desWS As Worksheet, fnd As Range, sCol2 As String
    Set desWS = Sheets("Weekly Client Numbers")
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lCol = Cells(5, Columns.Count).End(xlToLeft).Column
    sCol = Replace(Cells(5, lCol).Address(False, False), "5", "")
    Set fnd = Rows(4).Find("Attendance Dates")
    sCol2 = Replace(Cells(4, fnd.Column).Address(False, False), "4", "")
    If Intersect(Target, Range(sCol2 & "6:" & sCol & lRow)) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target <> "" Then
        strDate = Target
        Select Case Target.Column
            Case Is = fnd.Column
                Set foundDate = Sheets("Weekly Client Numbers").Range("B:B").Find(what:=DateValue(strDate), LookIn:=xlFormulas)
                If Not foundDate Is Nothing Then
                    desWS.Range("C" & foundDate.Row).Resize(, 6).Value = Range("P" & Target.Row).Resize(, 6).Value
                    Target.Offset(, -1) = "N"
                    Target.Offset(, -2) = WorksheetFunction.CountA(Range(fnd.Address).Offset(Target.Row - fnd.Row).Resize(, lCol - fnd.Column + 1))
                Else
                    MsgBox (Target & " not found.")
                    Exit Sub
                End If
            Case Is > fnd.Column
                Set foundDate = Sheets("Weekly Client Numbers").Range("B:B").Find(what:=DateValue(strDate), LookIn:=xlFormulas)
                If Not foundDate Is Nothing Then
                    desWS.Range("K" & foundDate.Row).Resize(, 6).Value = Range("P" & Target.Row).Resize(, 6).Value
                    Target.Offset(, -(Target.Column - fnd.Column + 1)) = "E"
                    Target.Offset(, -(Target.Column - fnd.Column + 2)) = WorksheetFunction.CountA(Range(fnd.Address).Offset(Target.Row - fnd.Row).Resize(, lCol - fnd.Column + 1))
                Else
                    MsgBox (Target & " not found.")
                    Exit Sub
                End If
        End Select
        Target.Offset(, -(Target.Column - fnd.Column + 1)).Select
    Else
        Select Case Target.Column
            Case Is = fnd.Column
                Set foundDate = Sheets("Weekly Client Numbers").Range("B:B").Find(what:=DateValue(Range("A2")), LookIn:=xlFormulas)
                If Not foundDate Is Nothing Then
                    desWS.Range("C" & foundDate.Row).Resize(, 6).ClearContents
                    Range("P" & Target.Row).Resize(, 6).ClearContents
                    Target.Offset(, -1).ClearContents
                    Target.Offset(, -2).ClearContents
                Else
                    MsgBox (Target & " not found.")
                    Exit Sub
                End If
            Case Is > fnd.Column
                Set foundDate = Sheets("Weekly Client Numbers").Range("B:B").Find(what:=DateValue(Range("A2")), LookIn:=xlFormulas)
                If Not foundDate Is Nothing Then
                    desWS.Range("K" & foundDate.Row).Resize(, 6).ClearContents
                    Range("P" & Target.Row).Resize(, 6).ClearContents
                    If Target.Column = fnd.Column + 1 Then
                        Target.Offset(, -(Target.Column - fnd.Column + 1)) = "N"
                    End If
                    Target.Offset(, -(Target.Column - fnd.Column + 2)) = WorksheetFunction.CountA(Range(fnd.Address).Offset(Target.Row - fnd.Row).Resize(, lCol - fnd.Column + 1))
                Else
                    MsgBox (Target & " not found.")
                    Exit Sub
                End If
        End Select
        Target.Offset(, -(Target.Column - fnd.Column + 1)).Select
    End If
    Range("A2").ClearContents
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[jeremy466clark]

Mumps, you have been absolutely brilliant. I really can't thank you enough. Everything seems to be working perfectly now. Thank you again

 

[mumps]

You are very welcome and thank you for the kind words.

 

[jeremy466clark]

You are very welcome and thank you for the kind words.

Hey Mumps - sorry, one last (hopefully small) problem

I can't seem to copy & paste any data from cells on the worksheet. When I click a cell to copy, the cell is highlighted as usual to copy, but then when I try to paste into another cell, the highlight disappears. No Paste options come up, either with right click, or using Ctrl V.

When I opened the downloaded file, it came up with a Yellow warning banner, saying "Protected View. Be careful........ etc" & I clicked "Enable Editing". That then led to a Red Banner saying "Security Risk, Blocked Macros" & I found online how to overcome that by opening Properties & clicking the Unlock button next to the "Security - This file came from another computer", but nowhere on the worksheet is it letting me copy & paste. It happilly lets me manually enter client details, but things would be much quicker if I could Copy & Paste. Any ideas?

Jeremy

 

[mumps]

The Worksheet_SelectionChange macro is executed automatically whenever you select a cell in the sheet. When you select a cell or a range of cells that you want to copy, it will allow the copy but then the clipboard is emptied when the Worksheet_SelectionChange is executed so there is nothing to paste. Unfortunately, this process can't be changed. You can try a work-around by doing the following:
-on the Home tab in the top menu, the first group is the Clipboard group.
-click the small arrow at the bottom right in that group and the "Office Clipboard" manager will open up.
-copy your cell or range.
-whenever you copy a cell or range, it will appear in the manager.
-select the cell where you want to paste and then click the desired data item in the manager.
-that data will be pasted.
-you can repeat the process to copy a different cell or range.
-click the Clear All button when done and close the manager.
Hopefully, this will work to do what you want.

 

[jeremy466clark]

The Worksheet_SelectionChange macro is executed automatically whenever you select a cell in the sheet. When you select a cell or a range of cells that you want to copy, it will allow the copy but then the clipboard is emptied when the Worksheet_SelectionChange is executed so there is nothing to paste. Unfortunately, this process can't be changed. You can try a work-around by doing the following:
-on the Home tab in the top menu, the first group is the Clipboard group.
-click the small arrow at the bottom right in that group and the "Office Clipboard" manager will open up.
-copy your cell or range.
-whenever you copy a cell or range, it will appear in the manager.
-select the cell where you want to paste and then click the desired data item in the manager.
-that data will be pasted.
-you can repeat the process to copy a different cell or range.
-click the Clear All button when done and close the manager.
Hopefully, this will work to do what you want.

Brilliant. Thanks again Mumps

 

[mumps]

My pleasure.

 

[jeremy466clark]

My pleasure.

Hi again Mumps

I bet you were hoping you'd heard the last from me!! Sorry..... again!

So, I've just loaded all the 2023 data from clients that I have. All was working perfectly - your copy & paste tip, the deleting where I entered wrong detail, the calender boxes. Everything perfect. Until I checked the Weekly Client Numbers tab.

It seems that it's only carrying over data from one occurence of every date? For any date in 2023, there's only one client showing and their associated Household Heads on the Weekly Client Numbers tab. I've not started entering 2024 yet, but assume that will be the same. If you're wondering why so many are entered as the 13th November 2023, thats just as far back as my Weekly Client Numbers Tab goes back, so any visits before that date, I've simply used the 13th. That won't cause us any problems.

I've attached a link of the actual sheet & data, although deleted contact details of the clients so there's no privacy issues. Can you have another look please? It just feels that we're so close to getting it perfect.

Thanks again

Jeremy

FFF New Improved Spreadsheet (Copy without Addresses).xlsm

1drv.ms