vba History Log of Data

[MM91]

Hello! I am newish to vba and I am trying to take data from one worksheet (sheet1) to clear all data in cells and then save history of data to new sheet(sheet2) to a table (historytable). It just needs to take the final total and record it under the correct name. Not sure where to start thank you! If there is a better way to save the data open to any suggestions!

Sheet1

Sheet 2

 

[fadee2]

hy mm91,

try the following code

Sub abc()
Dim d_lr As Long
Dim d_lc As Long
Dim h_lr As Long
Dim h_lc As Long

Dim d_lookup_rng As Range
Dim d_srch_rng As Range

d_lr = Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
d_lc = Sheets("sheet1").Cells(1, Columns.Count).End(xlToLeft).Column

h_lr = Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row


If Sheets("sheet2").Cells(h_lr, 1) = "" Then
    h_lr = 2
Else
    h_lr = h_lr + 1
End If

Set d_lookup_rng = Sheets("sheet1").Range(Sheets("sheet1").Cells(1, 2), Sheets("sheet1").Cells(1, d_lc))
Set d_srch_rng = Sheets("sheet2").Range("b1:z1")

EDate = InputBox("Please input date for Data Logging", "Provide Date")
EDate = CDate(EDate)

Dim rfind As Range
h_lc = Sheets("sheet2").Cells(1, 1).End(xlToLeft).Column

Sheets("sheet2").Cells(h_lr, 1) = EDate
For Each cell In d_lookup_rng
   
    If IsError(Application.Match(cell, d_srch_rng, 0)) Then
        h_lc = Sheets("sheet2").Cells(1, Columns.Count).End(xlToLeft).Column
        Sheets("sheet2").Cells(1, h_lc + 1) = cell
        Set rfind = Sheets("sheet1").Range(d_lookup_rng.Address).Find(what:=cell.Value, Lookat:=xlWhole)
      
        Sheets("sheet2").Cells(h_lr, h_lc + 1) = WorksheetFunction.Sum(Sheets("sheet1").Range(Sheets("sheet1").Cells(2, rfind.Column), Sheets("sheet1").Cells(d_lr, rfind.Column)))
    Else
            Set rfind = Sheets("sheet1").Range(d_lookup_rng.Address).Find(what:=cell.Value, Lookat:=xlWhole)
            Set dfind = Sheets("sheet2").Range(d_srch_rng.Address).Find(what:=cell.Value)
            Sheets("sheet2").Cells(h_lr, dfind.Column) = WorksheetFunction.Sum(Sheets("sheet1").Range(Sheets("sheet1").Cells(2, rfind.Column), Sheets("sheet1").Cells(d_lr, rfind.Column)))
    End If
Next cell

   
End Sub

The code asks the user for the input date, then looks for all of the given names available in sheet1, one at a time, in sheet2. if found, it sums all figures against these names and place them in corresponding column in sheet2. if a given name is not found in sheet2 then it creates a new entry of that name and then performs the sum.



hope this helps.

 

[fadee2]

the file is available here.

 

[MM91]

Thats great! perfect start for me and I can customize! Thank you so much!

 

[MM91]

hy mm91,

try the following code

Sub abc()
Dim d_lr As Long
Dim d_lc As Long
Dim h_lr As Long
Dim h_lc As Long

Dim d_lookup_rng As Range
Dim d_srch_rng As Range

d_lr = Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
d_lc = Sheets("sheet1").Cells(1, Columns.Count).End(xlToLeft).Column

h_lr = Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row


If Sheets("sheet2").Cells(h_lr, 1) = "" Then
    h_lr = 2
Else
    h_lr = h_lr + 1
End If

Set d_lookup_rng = Sheets("sheet1").Range(Sheets("sheet1").Cells(1, 2), Sheets("sheet1").Cells(1, d_lc))
Set d_srch_rng = Sheets("sheet2").Range("b1:z1")

EDate = InputBox("Please input date for Data Logging", "Provide Date")
EDate = CDate(EDate)

Dim rfind As Range
h_lc = Sheets("sheet2").Cells(1, 1).End(xlToLeft).Column

Sheets("sheet2").Cells(h_lr, 1) = EDate
For Each cell In d_lookup_rng
  
    If IsError(Application.Match(cell, d_srch_rng, 0)) Then
        h_lc = Sheets("sheet2").Cells(1, Columns.Count).End(xlToLeft).Column
        Sheets("sheet2").Cells(1, h_lc + 1) = cell
        Set rfind = Sheets("sheet1").Range(d_lookup_rng.Address).Find(what:=cell.Value, Lookat:=xlWhole)
     
        Sheets("sheet2").Cells(h_lr, h_lc + 1) = WorksheetFunction.Sum(Sheets("sheet1").Range(Sheets("sheet1").Cells(2, rfind.Column), Sheets("sheet1").Cells(d_lr, rfind.Column)))
    Else
            Set rfind = Sheets("sheet1").Range(d_lookup_rng.Address).Find(what:=cell.Value, Lookat:=xlWhole)
            Set dfind = Sheets("sheet2").Range(d_srch_rng.Address).Find(what:=cell.Value)
            Sheets("sheet2").Cells(h_lr, dfind.Column) = WorksheetFunction.Sum(Sheets("sheet1").Range(Sheets("sheet1").Cells(2, rfind.Column), Sheets("sheet1").Cells(d_lr, rfind.Column)))
    End If
Next cell

  
End Sub

The code asks the user for the input date, then looks for all of the given names available in sheet1, one at a time, in sheet2. if found, it sums all figures against these names and place them in corresponding column in sheet2. if a given name is not found in sheet2 then it creates a new entry of that name and then performs the sum.



hope this helps.

Hi I am trying to modify the sheet but the code does not seem to work as I need it to. It adds the new names to the top row instead of into the table. To make it more simple I added a row that totals the numbers so I just need the history table to record row 23. Any suggestions on how to modify the code or do it in another way? Thank you so much!!