VBA recording data entry and create a new excel with all these

[bhupender]

hello friends,
I need your help on this.

I do a lot of data entry in a excel file with multiple sheets with exactly same format. Sometimes after entering data in multiple sheets, I need to get a list of new entries I have done in a specific column of every sheet.
so please help me with a code. exactly I am looking for this.
as soon as I start the macro, it starts recording the value I am entering into cell A for all the sheets in one workbook.
after I complete data entry I want the macro to create a new excel sheet with the data I have punched in starting from the time when the macro started.

Hope I am not ambiguous in want I want.


thanks

 

[Takae]

Every sheet must have this code on sheet module.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then
        Exit Sub
    Else
        ReDim Preserve x(i)
            x(i) = Target.Value
            i = i + 1
    End If
End Sub

In General module.

Option Explicit
Public x(), i As Long
Sub g()
Dim ws As Worksheet, j As Long
Sheets.Add
Set ws = ActiveSheet
With ws
      For j = 0 To UBound(x)
        .Cells(j + 1, 1).Value = x(j)
      Next
      .Range(.Range("A1"), .Cells(i, 1)) = WorksheetFunction.Transpose(x)
End With
End Sub

 

[iliace]

I don't think you have to insert the event code in every sheet module. You should be able to use the Workbook_SheetChange() event instead.

To turn the tracking on and off, you probably want another global variable that determines whether each change should be tracked or not. There would be two procs, one to turn on the tracking and one to turn it off. The latter would also call the code - something like g() - to generate the output.

 

[Takae]

Thank you iliace. I totally forgot. I am able to use sheetchange event on Thiswokbook module...

ThisWorkbook Module

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
     If Intersect(Target, Range("A:A")) Is Nothing Then
        Exit Sub
    Else
        ReDim Preserve x(i)
            x(i) = Target.Value
            i = i + 1
    End If
 End Sub

General Module

Sub test()
Dim ws As Worksheet, j As Long
Sheets.Add
Set ws = ActiveSheet
With ws
      .Range(.Range("A1"), .Cells(i, 1)) = WorksheetFunction.Transpose(x)
      Erase x
End With
End Sub

 

[bhupender]

Thanks takae & iliace,

I tried this code but it showing error as "Variable not defined".
also, will this code work on every open workbook??

thanks

 

[Takae]

Sorry I droped declarations and added a line.
Please replace the old code with below code on general module.

Option Explicit
Public x(), i As Long
Sub test()
Dim ws As Worksheet, j As Long
Sheets.Add
Set ws = ActiveSheet
With ws
      .Range(.Range("A1"), .Cells(i, 1)) = WorksheetFunction.Transpose(x)
      Erase x
      i = 0
End With
End Sub

This code works on this workbook only.