VBA: Copy Paste Data with Merge Cells

[unknownymous]

Hi Gurus,

Good day!

Could you provide your insight on how the macro can paste the data from a worksheet to another with merge cells?

Workflow:
1. I have a main data worksheet and files to update. Files to update on this case is same with State provided in Source worksheet. All State data files are saved in a folder.
2. The macro will open each State file based on file name and update the State, Data and Status. There are merge cells here.
3. Autosave each file and close. If there are State file not in the list, macro will ignore.

Other: I'm using Microsoft Office 365

Appreciate the help.

 

[eiloken]

Hi Gurus,

Good day!

Could you provide your insight on how the macro can paste the data from a worksheet to another with merge cells?

Workflow:
1. I have a main data worksheet and files to update. Files to update on this case is same with State provided in Source worksheet. All State data files are saved in a folder.
2. The macro will open each State file based on file name and update the State, Data and Status. There are merge cells here.
3. Autosave each file and close. If there are State file not in the list, macro will ignore.

View attachment 101817

Other: I'm using Microsoft Office 365

Appreciate the help.

Macro will open each state file and insert data from Source data right? but what happened if state file already has data? macro will update new data into it or insert new data row? if update new data then state file always has 3 rows with data in row 3, is that true?

 

[unknownymous]

Macro will open each state file and insert data from Source data right? but what happened if state file already has data? macro will update new data into it or insert new data row? if update new data then state file always has 3 rows with data in row 3, is that true?

As for the file to update file, Row 3 is always blank. If there's a rare case that it has data then probably create a prompt message.

 

[eiloken]

i create macro to find match file name with source data and update data if row 3 of state file not include data:

Sub UpdateStateData()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim fso As Object, fol As Object, fil As Object
    Dim lr As Integer
    Dim rng As Range, cll As Range
    Dim wb As Workbook
    Dim filname As String, filext As String, filPath As String, result As String
    Dim count As Integer
    lr = ThisWorkbook.Sheets(1).Cells(Rows.count, 2).End(xlUp).Row
    If lr < 3 Then Exit Sub
    Set rng = ThisWorkbook.Sheets(1).Range("B3:B" & lr) 'set list of state in source data
    rng.Interior.Color = xlNone 'reset color of state list
    Set folder = Application.FileDialog(msoFileDialogFolderPicker) 'Choose folder include state file
    If folder.Show <> -1 Then Exit Sub
    xDir = folder.SelectedItems(1)
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fol = fso.GetFolder(xDir)
    For Each fil In fol.Files 'loop through files in folder
        filext = fso.GetExtensioNname(fil)
        If filext Like "xls*" Then 'check that file is excel file
            filname = fso.GetBaseName(fil)
            If Not rng.Find(filname, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) Is Nothing Then 'check that file found in source file
                filPath = fso.GetAbsolutePathName(fil) 'file path
                Set cll = rng.Find(filname, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) 'set cell that include data of state file
                Set wb = Workbooks.Open(fso.GetAbsolutePathName(filPath)) ' open file
                count = count + 1
                With wb.Sheets(1)
                    If IsEmpty(.Cells(3, 1)) Then 'if row 3 has not data then update data from source file and save else exit file without save
                        .Cells(3, 1).Value = cll.Value
                        .Cells(3, 3).Value = cll.Offset(, 1).Value
                        .Cells(3, 5).Value = cll.Offset(, 2).Value
                        cll.Interior.Color = RGB(0, 255, 0) 'highlight cell with green if update data
                        wb.Close (True)
                    Else
                        result = result & " - " & filname 'list all file has data in row 3
                        wb.Close (False)
                        cll.Interior.Color = RGB(255, 0, 0)  'highlight cell with red if state file already has data in row 3
                    End If
                End With
            End If
        End If
    Next fil
    If count > 0 Then
        If result = Empty Then
            MsgBox count & " files done", vbInformation
        Else
            MsgBox count & " file done with workbooks [" & result & "] already has data.", vbInformation
        End If
    Else
        MsgBox "Could not find any matching files", vbInformation
    End If
    Set fil = Nothing
    Set fol = Nothing
    Set fso = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

with this macro if state file not included data in row 3 then update data to file, save and highlight cell in source file with green, if row 3 already has data then highlight with red else if not found file name match in source list then not highlight cell.

 

[unknownymous]

i create macro to find match file name with source data and update data if row 3 of state file not include data:

Sub UpdateStateData()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim fso As Object, fol As Object, fil As Object
    Dim lr As Integer
    Dim rng As Range, cll As Range
    Dim wb As Workbook
    Dim filname As String, filext As String, filPath As String, result As String
    Dim count As Integer
    lr = ThisWorkbook.Sheets(1).Cells(Rows.count, 2).End(xlUp).Row
    If lr < 3 Then Exit Sub
    Set rng = ThisWorkbook.Sheets(1).Range("B3:B" & lr) 'set list of state in source data
    rng.Interior.Color = xlNone 'reset color of state list
    Set folder = Application.FileDialog(msoFileDialogFolderPicker) 'Choose folder include state file
    If folder.Show <> -1 Then Exit Sub
    xDir = folder.SelectedItems(1)
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fol = fso.GetFolder(xDir)
    For Each fil In fol.Files 'loop through files in folder
        filext = fso.GetExtensioNname(fil)
        If filext Like "xls*" Then 'check that file is excel file
            filname = fso.GetBaseName(fil)
            If Not rng.Find(filname, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) Is Nothing Then 'check that file found in source file
                filPath = fso.GetAbsolutePathName(fil) 'file path
                Set cll = rng.Find(filname, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) 'set cell that include data of state file
                Set wb = Workbooks.Open(fso.GetAbsolutePathName(filPath)) ' open file
                count = count + 1
                With wb.Sheets(1)
                    If IsEmpty(.Cells(3, 1)) Then 'if row 3 has not data then update data from source file and save else exit file without save
                        .Cells(3, 1).Value = cll.Value
                        .Cells(3, 3).Value = cll.Offset(, 1).Value
                        .Cells(3, 5).Value = cll.Offset(, 2).Value
                        cll.Interior.Color = RGB(0, 255, 0) 'highlight cell with green if update data
                        wb.Close (True)
                    Else
                        result = result & " - " & filname 'list all file has data in row 3
                        wb.Close (False)
                        cll.Interior.Color = RGB(255, 0, 0)  'highlight cell with red if state file already has data in row 3
                    End If
                End With
            End If
        End If
    Next fil
    If count > 0 Then
        If result = Empty Then
            MsgBox count & " files done", vbInformation
        Else
            MsgBox count & " file done with workbooks [" & result & "] already has data.", vbInformation
        End If
    Else
        MsgBox "Could not find any matching files", vbInformation
    End If
    Set fil = Nothing
    Set fol = Nothing
    Set fso = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

with this macro if state file not included data in row 3 then update data to file, save and highlight cell in source file with green, if row 3 already has data then highlight with red else if not found file name match in source list then not highlight cell.

Awesome! Thanks a lot.