VBA function to copy and paste data from a workbook,based on a set of conditions-CodePudding

The task at hand: I have 2 tables: one that needs to be filled with the data from the mastersheet and the mastersheet. Examples below:

I need to copy the data from the green sheet and, based on the date and specific text on line and column, to paste it into the white sheet in the correct columns and skip the incorrect ones. the delta line just calculates the differences between the mastersheet and evidence cells.

Until now i tried multiple formulas such as vlookup after the date in the white, but it grabs just the numbers from method 1, and if i use something like =if(and(A2=":\green.xlsx[sheet1]"A2; b2="mastersheet"; C1="method1"), ":\green.xlsx[sheet1]"C2; " "), and vlookups that grabs only the data for the method1 (but it does it correctly)

Tried to write a macro in vba and here is one of the problems: it returns runtime error 52. Code below:

Sub GrabFillData()
'declaring variables and explaining each one role
Dim path As String
Dim newfo As Workbook 'newfo is the newly opened workbook
Dim newfows As Sheets 'newfows is a speciffied sheet to copy data from



With Application.FileDialog(msoFileDialogOpen)
    .Show
    If .SelectedItems.Count = 1 Then
        path = .SelectedItems(1)
    End If
End With

If path <> "" Then
    Open path For Output As #n      ' runtime error 52
End If

The same error i get when i use

Sub GetPath()
Dim path As String

path = InputBox("Enter a file path", "Title Here")
Open path For Output As #1
Close #1
End Sub

Another problem is that i thought i knew how to make the conditions for the copy-paste actions and i need a little help with that.

The macro will be running from the white sheet.

If there any formula that can make this easier?

CodePudding user response：

If you can change the column names in white sheet to "method1", "method2",... OR If you can change the row values in green sheet to "payment1", "payment2",... Then you can use a complex INDEX MATCH function. Follow the link below.

https://i.stack.imgur.com/xxACM.png

Using VBA there are a couple of thing with your code.. let's go 1 by 1.

Dim wb As Workbook, path As String

'You can use FileDialogFilePicker instead
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False    'Forces to choose 1 file.
    If .Show = -1 Then    'Checks if OK button was clicked.
        path = .SelectedItems(1)
    End If
End With

'Use Workbooks.Open method instead of Open.
Set wb = Workbooks.Open(path)

Copy Pasting is easy.

Range("A1").Copy
Range("B5").PasteSpecial xlPasteValues 'Paste from A1 to B5

CodePudding user response：

Sub GrabFillData()
'declaring variables and explaining each one role
Dim path As String
Dim newfo As Excel.Workbook 'newfo is the newly opened workbook
Dim Cell_1 As String  ' Cell_1 refer to one cell in workbook
Dim newfows As Integer 'newfows is a speciffied sheet to copy data from
newfows = ActiveSheet.Index


With Application.FileDialog(msoFileDialogOpen)
    .Show
    If .SelectedItems.Count = 1 Then
        path = .SelectedItems(1)
    End If
End With

If path <> "" Then
    'Open path For Output As #n      ' runtime error 52
  Set newfo = Excel.Application.Workbooks.Open(path) ' connect to workbook
  Cell_1 = newfo.Sheets(newfows).Cells(2, 2) ' retrieve value of selected cell to string variable
End If

End Sub

CodePudding user response：

Please, try the next code to process the two sheets as (I understood) you need. You did not answer my last clarification questions and the code assumes that maximum number of methods is 4 and unique occurrences exist for each such method. Using arrays and working mostly in memory, the code should be very fast, even for large ranges. It will return in "H2" all processed range. If you like the return, you should replace "H2" with "A2" in the last code line:

Sub ProcessPayments()
 Dim shT As Worksheet, lastRT As Long, shM As Worksheet, lastRM As Long, dict As Object
 Dim arr, arrInt, arrT, i As Long, j As Long, k As Long, arrMeth, mtch
 arrMeth = Split("method1,method2,method3,method4", ",")

 Set shT = ActiveSheet 'the white sheet
 lastRT = shT.Range("A" & shT.rows.count).End(xlUp).row  'last row in A:A
 arrT = shT.Range("A2:F" & lastRT).value 'place the range in an array for faster iteration

 Set shM = shT.Next ' use here the master sheet you need
 lastRM = shM.Range("A" & shM.rows.count).End(xlUp).row  'last row in A:A
 arr = shM.Range("A2:C" & lastRM).value 'place the range in an array for faster iteration

 Set dict = CreateObject("Scripting.Dictionary") 'set the dictionary
 For i = 1 To UBound(arr)    'iterate between the array rows and place the necessary values in dictionary
    If Not dict.Exists(arr(i, 1)) Then 'when the dictionary key does not exist, add a dictionary key as the Date value:
        dict.Add arr(i, 1), Array(Array(arr(i, 2), arr(i, 3))) 'place the item as an array of two elements (method and value)
    Else                     'if the key exists, it add another element in the jagged array containing method ad value
        arrInt = dict(arr(i, 1)): ReDim Preserve arrInt(UBound(arrInt)   1)  'redim the existing array item with one element
        arrInt(UBound(arrInt)) = Array(arr(i, 2), arr(i, 3))                 'place another array of two in the last added element
        dict(arr(i, 1)) = arrInt                                                             'place the intermediary array back to dictionary
    End If
 Next i

 'Put the necessary data in the white sheet fields:
 For i = 1 To UBound(arrT)                      'iterate between the array elements:
    If arrT(i, 2) = "mastersheet" Then          'for the rows having "mastersheet" in the second column:
        For j = 0 To dict.count - 1             'iterate between the dictionary keys:
            If arrT(i, 1) = dict.Keys()(j) Then 'when the dictionary key has been found:
                For k = 0 To UBound(dict.items()(j)) 'Iterate between each array of the jag array item:
                    'match the array first item (method) in arrMeth (to set the column where to place the value):
                    mtch = Application.match(dict.items()(j)(k)(0), arrMeth, 0)
                    arrT(i, mtch   2) = dict.items()(j)(k)(1)   'place the value in the appropriate column (the second array element)
                Next k
            End If
        Next j
    End If
 Next i
 'Place back the processed array, but not in "A2", only to check if its return is convenient and drop its content in "H2".
 'If convenient, please replace "H2" whith "A2"
shT.Range("H2").Resize(UBound(arrT), UBound(arrT, 2)).value = arrT
End Sub

I could not understand from your question if the two involved sheets belong to the same workbook. The above code works with sheets from different workbooks/worksheets, too. You should take care to correctly set shM. Now it is the next sheet after the white one...

If you need to let the code opening the workbook using a dialog, this should be piece of cake. You already received answer(s) for this simple parte, I think...

I tried commenting each code line. If something not so clear, do not hesitate to ask for clarifications. But after testing it...