Thread: Need a macro to update data from raw file to individual sheets of master

Hi Everyone,

I need a code for the following steps to be enacted

1. Save a backup file with the name counts - date.xls (this will be a
daily file)
2. remove rows with name (column B) matching with name in to be
removed sheet
3. copy value in name field and open the corusponding sheet in the
master
4. once the sheet is active, go to the last row insert current date in
left most collumn and paste the row from raw to master (from Column B)
5. copy the formula in the remailing columns in that sheet from above
6. once updated give a msg = this work is now complete

Conditions -
1. If the sheet does not exist in the master then give an inputbox
informing that we have a new name and asking if a new sheet should be
created or should this be merged with another existing sheet - if user
says yes to new sheet then create a new one with the same headers/
formatting and formulas as the others
2. In the end in the msg box (this work is now complete) it should
contain a summary of unusual events i.e.
A. New name (sheet created)
B. New name (merged with existing sheet)
C. Count for particular name in Column C2 greater than 50 (Name-
column B and count - C2 detail)

I tried my hand on this but got stuck half way. i was not able to find
a way to put condition 3 in the code.

This is really urgent ....I would be really really really greatful if
someone can help me out here.

Thanks a lot

I have attached a sample file for test and master with this post along
with my code.

Code:

Sub Counts_upload()
'
' Counts_upload Macro
' This macro is used to load running counts from raw to master workbook
' Keyboard Shortcut: Ctrl+Shift+A
   Workbooks("test").Sheets("raw").Select
    Range("A1").Select
    Dim i As Integer
    last = Cells(Rows.Count, "B").End(xlUp).Row
    For i = last To 1 Step -1
        If (Cells(i, "B").Value) = "ABC" Then
            Cells(i, "A").EntireRow.Delete
        End If
        If (Cells(i, "B").Value) = "XYZ" Then
            Cells(i, "A").EntireRow.Delete
        End If
        If (Cells(i, "B").Value) = "Res" Then
            Cells(i, "A").EntireRow.Delete
        End If
        Next i
    ChDir "C:\Desktop\counts"
    Dim flname As Long
    ActiveWorkbook.SaveCopyAs "C:\Desktop\counts\counts - " & Format(Date, "dd-mmm-yy") & ".xls"
    Workbooks("test").Sheets("raw").Select
    Dim k As Integer
    Dim wrk As Worksheet
    Dim n As Integer
    Dim countnonblank As Integer
    Dim myRange As Range
    Set myRange = Columns("B:B")
    countnonblank = Application.WorksheetFunction.CountA(myRange)
    n = countnonblank
    For k = 2 To n Step 1
    wrk = Worksheets("raw").Range("B" & k).Value
    Worksheets("raw").Cells(k, "A").EntireRow.Copy
    If k = "" Then
    Exit Sub
    End If
    Worksheets(wrk).Range("A1").selct
    activecell.End(xlDown).Select
    activecell.Offset(1, 0).Select
    activecell.Value = Date
    activecell.Offset(0, 1).Select
    activecell.PasteSpecial
    Next k
    End Sub

I was trying to understand your problem but it was not very clear. Maybe you can try and explain it in a better way.

Also, in your code, you can replace -

For i = last To 1 Step -1
        If (Cells(i, "B").Value) = "ABC" Then
            Cells(i, "A").EntireRow.Delete
        End If
        If (Cells(i, "B").Value) = "XYZ" Then
            Cells(i, "A").EntireRow.Delete
        End If
        If (Cells(i, "B").Value) = "Res" Then
            Cells(i, "A").EntireRow.Delete
        End If
        Next i

with

For i = last To 1 Step -1
        If (Cells(i, "B").Value) = "ABC" or Cells(i,"B").value = "XYZ" or Cells(i,"B").value ="Res" Then
            Cells(i, "A").EntireRow.Delete
        End If
        Next i

This makes it much shorter.

Also you should always declare your variables at the beginning of the code. Don't "dim" any variables in between.

Hey Arlu,

Thanks for looking into it. Basically I m just a beginner in VBA, also I was just trying to write the code (hit n try) whatever i could figure out might work.

Well the basic requirement here is that we get raw data on certain applications on a daily basis that is pasted on the raw file, from here we save a backup file and then update the master file where we have an individual worksheet for each application. before this we remove the applications that do not concern us (mentioned in the to be removed sheet).

in the master workbook in every application sheet the first column is for the date and then the data regarding that app in the raw is pasted. the remaining columns run formulas which are to be copied down on every row.

Other than this we need to keep track of
1. any new application/or name change of application (this needs to be done manually as we do not have any way to input name changes in advance hence the input box suggestion for this.)
2. any high count (greater than 50) on any application

sorry for the confusing post ... hope this helps in getting a better understanding

Hey Varun,

Find below the code for all your steps above. I couldn't understand condition C. If you can explain that to me, i can have that inputted in the code as well. Test the below and let me know if you face any issues.

Sub copy_data()

Dim NewFN As String
Dim MasterFN As String

'Open the Master file
proceed:
MasterFN = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", Title:="Please open the Master File")
If MasterFN = "" Then
    MsgBox "You have not selected a file."
    GoTo proceed
Else
    Workbooks.Open Filename:=MasterFN
End If
MasterFN = ActiveWorkbook.Name

'Open the test file
proceed1:
NewFN = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", Title:="Please select a file")
If NewFN = "" Then
    MsgBox "You have not selected a file."
    GoTo proceed1
Else
    Workbooks.Open Filename:=NewFN
End If


'Save backup file
ActiveWorkbook.SaveAs Filename:="D:\Counts-" & Format(Date, "dd-mmm-yy") & ".xlsx", FileFormat:= _
      xlOpenXMLWorkbook, CreateBackup:=False

Workbooks("Counts-" & Format(Date, "dd-mmm-yy") & ".xlsx").Close

Workbooks.Open Filename:=NewFN
NewFN = ActiveWorkbook.Name

'Delete the "to be removed" IDs
Workbooks(NewFN).Activate
lrow = Worksheets("To be removed").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lrow

    Worksheets("Raw").Rows("1:1").AutoFilter field:=1, Criteria1:=Worksheets("To be removed").Range("A" & i).Value
    
    With ActiveSheet
        Set rngF = .AutoFilter.Range
        If rngF.Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
                    .Cells.Count = 1 Then
                GoTo cont
        End If
    
    End With

    With rngF  'ignore the header from the count and come down one row
            'On Error GoTo extra
            Set rngV = .Resize(.Rows.Count - 1, 1).Offset(1, 0).Cells.SpecialCells(xlCellTypeVisible)
    End With

    rngV.Next.EntireRow.Delete

cont:
Next i

Worksheets("Raw").Rows("1:1").AutoFilter

lrow = Worksheets("Raw").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lrow

update_data:

    SName = Workbooks(NewFN).Worksheets("Raw").Range("B" & i).Value
    On Error GoTo new_tab
    Workbooks(NewFN).Worksheets("Raw").Range("A" & i & ":I" & i).Copy Workbooks(MasterFN).Worksheets(SName).Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
    Workbooks(MasterFN).Worksheets(SName).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Format(Date, "dd-mmm-yy")
    drow = Workbooks(MasterFN).Worksheets(SName).Range("K" & Rows.Count).End(xlUp).Offset(1, 0).Row
    Workbooks(MasterFN).Worksheets(SName).Range("K" & drow - 1 & ":S" & drow - 1).Copy Workbooks(MasterFN).Worksheets(SName).Range("K" & drow & ":S" & drow)

Next i

new_tab:
MsgBox "New Name encountered", vbCritical
UserA = InputBox("Should a new sheet be inserted for the new name?", "New Name", "Yes")
If UserA = "Yes" Then
    Workbooks(MasterFN).Sheets.Add after:=Workbooks(MasterFN).Sheets(Worksheets.Count)
    ActiveSheet.Name = SName
Else: UserA = "No"
    UserB = InputBox("Specify the name of the sheet where the data should be merged")
    SName = UserB
End If

    Workbooks(NewFN).Worksheets("Raw").Range("A" & i & ":I" & i).Copy Workbooks(MasterFN).Worksheets(SName).Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
    Workbooks(MasterFN).Worksheets(SName).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Format(Date, "dd-mmm-yy")
    drow = Workbooks(MasterFN).Worksheets(SName).Range("K" & Rows.Count).End(xlUp).Offset(1, 0).Row
    Workbooks(MasterFN).Worksheets(SName).Range("K" & drow - 1 & ":S" & drow - 1).Copy Workbooks(MasterFN).Worksheets(SName).Range("K" & drow & ":S" & drow)

If UserA = "" Then
    MsgBox "This work is now complete"
ElseIf UserA = "Yes" Then
    MsgBox "This work is now complete, new sheet added " & SName
ElseIf UserA = "No" Then
    MsgBox "This work is now complete, merged with sheet " & UserB
End If

End Sub

Note: In the Master file, i also found formulae from columns K to S missing in some of the tabs, i have inputted that and then run the code. So maybe you can have those formulae inputted first and then save and close your file. The macro will then ask you to open the master file.

Also, when the new tab got added for RRS, there were no headings or formulae, so it just inputted the data. Maybe once the macro runs, you can complete that part of the sheet.

Hey Arlu,

This works great till the decision making for new sheet/merging with existing sheet comes.

1. in case we reply with Yes on the first input box of "Should a new sheet be inserted for the new name?"

It renames the "raw" sheet of the "test" workbook instead of the new sheet added in the "master" workbook. The new sheet inserted in the master remains named "Sheet1".

Since this renames the raw sheet the macro does not execute further since it is not able to locate sheet - raw.

2. In case of "Specify the name of the sheet where the data should be merged" input box, although it does paste the data in the correct sheet but it does not continue pasting the remaining rows. (To check this I moved the RRS row up in the order. It did not paste the rows below it.)

Thanks for your help.

Varun

Sorry forgot to add two points here....

1. Is it possible to change the sheet names from name (Column B) to ID (Column A), I found in the long run Column B may not remain unique, Although I would have change all historic files but I think that would be a much better way to go....Sorry, realised it so late

2. From msgbox for count greater than 50 I meant, is it possible to give a summary of all the rows from raw sheet to the user in one msgbox.

Condition - Column D (C2) >50, return value in msgbox - Column A (ID), Column B (Name), Column D (C2)

I tried but could not get it in a combined msgbox.

Thanks a lot !!!

I can help you with point 1. Regarding point 2, it wont be a good output when you display it in a msgbox. Is there any other place you would want it to be displayed? Like maybe on the raw file itself, we can have those rows highlighted where it is >50?

You can use this edited code -

Sub copy_data()

Dim NewFN As String, MasterFN As String, UserA As String, UserB As String
Dim lrow As Long, i As Long, drow As Long
Dim rngf As Range, rngv As Range
Dim SName As Variant

'Open the Master file
proceed:
MasterFN = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", Title:="Please open the Master File")
If MasterFN = "" Then
    MsgBox "You have not selected a file."
    GoTo proceed
Else
    Workbooks.Open Filename:=MasterFN
End If
MasterFN = ActiveWorkbook.Name

'Open the test file
proceed1:
NewFN = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", Title:="Please select a file")
If NewFN = "" Then
    MsgBox "You have not selected a file."
    GoTo proceed1
Else
    Workbooks.Open Filename:=NewFN
End If


'Save backup file
ActiveWorkbook.SaveAs Filename:="D:\Counts-" & Format(Date, "dd-mmm-yy") & ".xlsx", FileFormat:= _
      xlOpenXMLWorkbook, CreateBackup:=False

Workbooks("Counts-" & Format(Date, "dd-mmm-yy") & ".xlsx").Close

Workbooks.Open Filename:=NewFN
NewFN = ActiveWorkbook.Name

'Delete the "to be removed" IDs
Workbooks(NewFN).Activate
lrow = Worksheets("To be removed").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lrow

    Worksheets("Raw").Rows("1:1").AutoFilter field:=1, Criteria1:=Worksheets("To be removed").Range("A" & i).Value
    
    With ActiveSheet
        Set rngf = .AutoFilter.Range
        If rngf.Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
                    .Cells.Count = 1 Then
                GoTo cont
        End If
    
    End With

    With rngf  'ignore the header from the count and come down one row
            'On Error GoTo extra
            Set rngv = .Resize(.Rows.Count - 1, 1).Offset(1, 0).Cells.SpecialCells(xlCellTypeVisible)
    End With

    rngv.Next.EntireRow.Delete

cont:
Next i

Worksheets("Raw").Rows("1:1").AutoFilter

lrow = Worksheets("Raw").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lrow

update_data:

    SName = Workbooks(NewFN).Worksheets("Raw").Range("A" & i).Value
    On Error GoTo new_tab
    Workbooks(NewFN).Worksheets("Raw").Range("A" & i & ":I" & i).Copy Workbooks(MasterFN).Worksheets(SName).Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
    Workbooks(MasterFN).Worksheets(SName).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Format(Date, "dd-mmm-yy")
    drow = Workbooks(MasterFN).Worksheets(SName).Range("K" & Rows.Count).End(xlUp).Offset(1, 0).Row
    Workbooks(MasterFN).Worksheets(SName).Range("K" & drow - 1 & ":S" & drow - 1).Copy Workbooks(MasterFN).Worksheets(SName).Range("K" & drow & ":S" & drow)

Next i

new_tab:
MsgBox "New Name encountered", vbCritical
UserA = InputBox("Should a new sheet be inserted for the new name?", "New Name", "Yes")
If UserA = "Yes" Then
    Workbooks(MasterFN).Sheets.Add(after:=Workbooks(MasterFN).Sheets(Worksheets.Count)).Name = SName
Else: UserA = "No"
    UserB = InputBox("Specify the name of the sheet where the data should be merged")
    SName = UserB
End If

    Workbooks(NewFN).Worksheets("Raw").Range("A" & i & ":I" & i).Copy Workbooks(MasterFN).Worksheets(SName).Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
    Workbooks(MasterFN).Worksheets(SName).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Format(Date, "dd-mmm-yy")
    drow = Workbooks(MasterFN).Worksheets(SName).Range("K" & Rows.Count).End(xlUp).Offset(1, 0).Row
    Workbooks(MasterFN).Worksheets(SName).Range("K" & drow - 1 & ":S" & drow - 1).Copy Workbooks(MasterFN).Worksheets(SName).Range("K" & drow & ":S" & drow)

If UserA = "" Then
    MsgBox "This work is now complete"
ElseIf UserA = "Yes" Then
    MsgBox "This work is now complete, new sheet added - " & SName
ElseIf UserA = "No" Then
    MsgBox "This work is now complete, merged with sheet " & UserB
End If

End Sub

I have declared "SName" (name of the sheet in the master file) as a variant. So you can even use the IDs instead of name. Let me know if you face any issues with the code.