Newbie help for a good cause, please

J

jeremy466clark

New Member
Joined
Jan 31, 2024
Messages
21
Office Version
  1. 365
Platform
  1. Windows
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
Screenshot (13).png
Screenshot (12).png
 
Sort by date Sort by votes
Click here for your file. I tried to make the code as dynamic as possible so that if you need to insert additional columns in the future, you can do so as long as you insert them between column W and column AC in the All Clients & Attendance sheet. To facilitate this, you'll notice some changes in the All Clients & Attendance sheet starting in column AH where I have inserted numbers in row 5. These are necessary to give me the number of columns used. You will not need to enter data in columns AF and AG as these columns will be populated automatically. You can add more columns to the right of column BB and continue the sequential numbering in the new columns. In the Weekly Client Numbers sheet you will see actual dates in column B instead of the week days. This is also necessary so that they match the dates you select in the All Clients & Attendance sheet. I would suggest that you create a separate file for each year. In this manner your workbook won't get too long and hard to manage.
This is the code in the file:
VBA Code: 
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
    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
                Cells(Target.Row, fnd.Column - 1) = "N"
                Cells(Target.Row, 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
        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
                Range("B" & Target.Row) = "E"
                Cells(Target.Row, fnd.Column - 1) = "E"
                Cells(Target.Row, 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
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

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", "")
    If Intersect(Target, Range(sCol2 & "6:" & sCol & lRow)) Is Nothing Then Exit Sub
    CalendarFrm.Show
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
mumps said:
Click here for your file. I tried to make the code as dynamic as possible so that if you need to insert additional columns in the future, you can do so as long as you insert them between column W and column AC in the All Clients & Attendance sheet. To facilitate this, you'll notice some changes in the All Clients & Attendance sheet starting in column AH where I have inserted numbers in row 5. These are necessary to give me the number of columns used. You will not need to enter data in columns AF and AG as these columns will be populated automatically. You can add more columns to the right of column BB and continue the sequential numbering in the new columns. In the Weekly Client Numbers sheet you will see actual dates in column B instead of the week days. This is also necessary so that they match the dates you select in the All Clients & Attendance sheet. I would suggest that you create a separate file for each year. In this manner your workbook won't get too long and hard to manage.
This is the code in the file:
VBA Code: 
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
    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
                Cells(Target.Row, fnd.Column - 1) = "N"
                Cells(Target.Row, 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
        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
                Range("B" & Target.Row) = "E"
                Cells(Target.Row, fnd.Column - 1) = "E"
                Cells(Target.Row, 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
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

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", "")
    If Intersect(Target, Range(sCol2 & "6:" & sCol & lRow)) Is Nothing Then Exit Sub
    CalendarFrm.Show
    Application.ScreenUpdating = True
End Sub
Click to expand...
Absolutely Brilliant, Mumps. I can't thank you enough.

Just two points. Firstly, I set up Columns AD & AE to simply copy the client names as entered from Columns B&C. . This is working fine when a clients name is first entered for their first attendance, but when I enter a second or subsequent attendance date for the same client and Column AG correctly automatically changes to "E", then Column AD also seems to change to an "E", rather than leaving the first name showing. Can you correct this please?

Secondly, if a wrong date is entered on the Clients & Attendance sheet from the calender pop-up, or perhaps a visit is entered in error under the wrong client, how do I delete the incorrect data entered in the cell without mucking up the code / macros, and also in that scenario, how do I delete the figures carried over incorrectly to the Weekly Client Numbers tab? I tried just right clicking & choosing Clear Contents on both tabs, as I would usuallly to delete data, but then started getting warning boxes about debugging etc & I seemed to muck everything up.

Sorry, I did warn you I was a newbie!!

Kind regards again

Jeremy
 
Upvote 0
jeremy466clark said:
Absolutely Brilliant, Mumps. I can't thank you enough.

Just two points. Firstly, I set up Columns AD & AE to simply copy the client names as entered from Columns B&C. . This is working fine when a clients name is first entered for their first attendance, but when I enter a second or subsequent attendance date for the same client and Column AG correctly automatically changes to "E", then Column AD also seems to change to an "E", rather than leaving the first name showing. Can you correct this please?

Secondly, if a wrong date is entered on the Clients & Attendance sheet from the calender pop-up, or perhaps a visit is entered in error under the wrong client, how do I delete the incorrect data entered in the cell without mucking up the code / macros, and also in that scenario, how do I delete the figures carried over incorrectly to the Weekly Client Numbers tab? I tried just right clicking & choosing Clear Contents on both tabs, as I would usuallly to delete data, but then started getting warning boxes about debugging etc & I seemed to muck everything up.

Sorry, I did warn you I was a newbie!!

Kind regards again

Jeremy
Click to expand...
Oh, and I've just spotted it's changing Column B's first name to an "E" also
 
Upvote 0
jeremy466clark said:
Oh, and I've just spotted it's changing Column B's first name to an "E" also
Click to expand...
And I've also just spotted, is it possible for all date in Columns AF onwards to be reordered automatically depending on how I filter other columns. For instance, if I filter the clients in Surname alphabetic order, then switch to viewing them in alphabetic order under their Town column, I'd want their attendance dates and numbers moving automatically too. Basically, I'd want to be able to view a clients' attendance dates and total visit numbers and whether they were new or existing, no matter which column I filtered into order
 
Upvote 0
jeremy466clark said:
if a wrong date is entered on the Clients & Attendance sheet from the calender pop-up, or perhaps a visit is entered in error under the wrong client, how do I delete the incorrect data entered in the cell without mucking up the code / macros, and also in that scenario, how do I delete the figures carried over incorrectly to the Weekly Client Numbers tab? I
Click to expand...
If a wrong date is entered, simply click on it and select a new date. If you simply want to delete the date to leave the cell blank, click on the cell, close the date pop-up and press the DELETE key. To delete any other data, simply click on the cell or highlight the range and press the DELETE key.

jeremy466clark said:
is it possible for all date in Columns AF onwards to be reordered automatically depending on how I filter other columns
Click to expand...
When you filter on any one column, all the visible rows should retain their original data so I'm not sure what is happening.

Replace the existing macro in the worksheet code module with the following:
VBA Code: 
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
    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
                Range("AG" & Target.Row) = "N"
                Range("AF" & Target.Row) = 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
                Range("AG" & Target.Row) = "E"
                Range("AF" & Target.Row) = 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
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
If a wrong date is entered, simply click on it and select a new date. If you simply want to delete the date to leave the cell blank, click on the cell, close the date pop-up and press the DELETE key. To delete any other data, simply click on the cell or highlight the range and press the DELETE key.


When you filter on any one column, all the visible rows should retain their original data so I'm not sure what is happening.

Replace the existing macro in the worksheet code module with the following:
VBA Code: 
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
    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
                Range("AG" & Target.Row) = "N"
                Range("AF" & Target.Row) = 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
                Range("AG" & Target.Row) = "E"
                Range("AF" & Target.Row) = 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
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Click to expand...
I'm so sorry Mumps
I have no idea how to replace a macro in a worksheet code module. I know nothing about codes, modules or macros
I've uploaded a link again if you could possibly do it for me again.
I'm pretty sure when I filtered different columns, the clients' attendance details didn't move to the new corresponding rows, but I'll check again when / if (hopefully) you send another amended link
Thank you again
Jeremy

FFF Test Spreadsheet.xlsx

1drv.ms 1drv.ms
 
Upvote 0
Have a look at Post #6 where I describe how to view the code. Follow those steps and simply delete the old macro and copy/paste the new code. Then close the code window to return to your sheet.
 
Upvote 0
mumps said:
Have a look at Post #6 where I describe how to view the code. Follow those steps and simply delete the old macro and copy/paste the new code. Then close the code window to return to your sheet.
Click to expand...
Thanks Mumps
So, I've copy & pasted the code on the "All Clients & Attendance" tab (see pic below) but as soon as I enter any details in any cell, I get an error code (See the 2nd pic below)
Sorry to be a pain
Screenshot (15).png
Screenshot (14).png
 
Upvote 0
You didn't placed the macro in the most recent version of the file I attached. Click here for your file.
 
Upvote 0
mumps said:
You didn't placed the macro in the most recent version of the file I attached. Click here for your file.
Click to expand...
Hey Mumps
You've been absolutely brilliant & I can't thank you enough.

I am, however, still getting an error box whenever I delete a date in the attendance date boxes after closing the calender pop-up.
It shows - Run Time Error "13"
Type Mismatch

then gives the options to End, Debug, or Help

I am following your instructions - Click on the box, close the calender pop-up, then use the Delete button to clear the previously selected date, but I still get the error box. So I haven't been able to test if by deleting the date, it correctly deletes the numbers carried over to the Weekly Client Numbers tab, & I haven't been able to test when (if necessary) I delete a 2nd attendance date, it changes Column AG on the All Clients tab back from E to N.

Apart from that, I think we're there. Whatever you did has fixed the copying names from Columns B&C, & I've realised why the Filtering wasn't working - I hadn't added filter buttons to every column

Thanks again

Jeremy
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
Automating copying of columns within same sheet in excel using VBA.
Replies
1
Views
151
MountainFog
M
J
  • Locked
  • Question
Still need help on a daily summary sheet
Replies
1
Views
301
Fluff
Fluff
Y
  • Question
Excel Formula --> Return column heading dependent on data in rows (& conditions)
Replies
1
Views
293
Herakles
H
J
  • Question
Complex Move data from two spreadsheets with similar data in different columns to a specific column in an existing spreadsheet(Sheet 3)
Replies
0
Views
124
JMC57
J
G
  • Solved
History of Dates to be traced in Excel (2010) in DD/MM/YYYY format
2
Replies
11
Views
403
MARK858
MARK858

Forum statistics

Threads
1,215,113
Messages
6,123,165
Members
449,099
Latest member
bes000

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top