VBA Returning value loop based on date and one other identifier

Question

I am doing some work which requires automating payment approval requests, the issue I am having is that there are two identifiers for the payment requests with multiple payments, So for example I wish to make 4 payments with the flag apple and 5 payments with the flag banana. The macro will need to look up all payments with the payment date of today and then determine whether or not this payment is for apple or banana. It will then copy all payments for today for both and paste them on another sheet.

Let's assume that The date identifier is on cell A2 on Source Data Sheet and the dates are in cells F4 to F2000 and the apple/banana flag is in G4 to G2000.

I want to take the value of the payment in cells H4 to H2000 and paste them on either Apples Payment tab or Banana Payment tab along with it's unique reference number in cells I4 to I2000.

I have attempted to use something else I have found on here but I am really struggling, could somebody please help me!

Sub Fruit()
    Dim lastRow As Long
    Dim lastTRow As Long    'Last Target Row
    Dim tRow As Long        'Target Row
    Dim source As String    'The source sheet
    Dim target As String    'Variable target sheet
    Dim tempVal As String   'Hold value of Source!B2
    Dim ws As Worksheet

    source = "Source Data"
    lastRow = Sheets("Source Data").Range("D" & Rows.Count).End(xlUp).Row

    For lRow = 3 To lastRow                 'Loop through source sheet
        tempVal = Sheets("Source Data").Cells(lRow, "D").Text
        If Sheets("Source Data").Cells(lRow, "F").Value = tempVal Then
            Sheets("Source Data").Cells(lRow, "I").Copy
            lastTRow = Sheets("Banana").Range("C" & "70").End(xlUp).Row          'Get Last Row
            tRow = lastTRow + 1             'Set new Row 1 after last
            'tRow.Select.Paste
            'Copy cells from one sheet to another loop columns
            Sheets("Banana").Cells(tRow, "C").PasteSpecial
        End If
    Next lRow
End Sub

I edited your code to correct the indenting in an effort to make the code more readable. On doing so I noticed you missed an End If statement at the end -- the beauty of correct indenting is that you notice these errors very quickly! — CallumDA
– CallumDA, Commented Feb 6, 2017 at 16:02

VBA Pete · Accepted Answer · 2017-02-06 17:11:08Z

Your code is not matching fully what you described, so I went with your description. There are a few issues with your code:

the value in column H is not being copied
A second if statement is missing assigns the values either to the bananas or apples spreadsheet

I have updated your code to check in column H for the flag and then moves the values in H and I to cells C & D into either the Apple worksheet or the Banana worksheet based on the flag:

Sub Fruit()

Dim lastRow As Long
Dim lastRowData As Long, lastRowApples As Long, lastRowBananas As Long  'Last Target Row
Dim tRow As Long        'Target Row
Dim tempVal As String   'Hold value of Source!B2
Dim wsSource As Worksheet, wsApples As Worksheet, wsBananas As Worksheet

Set wsSource = ThisWorkbook.Sheets("Source Data")
Set wsApples = ThisWorkbook.Sheets("Apples")
Set wsBananas = ThisWorkbook.Sheets("Bananas")

lastRowData = wsSource.Range("D" & Rows.Count).End(xlUp).Row

    For lRow = 3 To lastRowData 'Loop through source sheet
        If wsSource.Range("D" & lRow).Value = wsSource.Range("F" & lRow).Value Then
            If wsSource.Range("G" & lRow).Value = "Apples" Then ' check for apple flag in column G
                wsSource.Range("H" & lRow & ":I" & lRow).Copy wsApples.Range("C" & wsApples.Range("C" & Rows.Count).End(xlUp).Row + 1) 'Copy Cells H&I in Cells C:D in the sheet
            ElseIf wsSource.Range("G" & lRow).Value = "Bananas" Then ' check for banana flag in column G
                wsSource.Range("H" & lRow & ":I" & lRow).Copy wsBananas.Range("C" & wsBananas.Range("C" & Rows.Count).End(xlUp).Row + 1) 'Copy Cells H&I in Cells C:D in the sheet
            End If
        End If
    Next lRow

End Sub

No worries @JDRows. Don't forget to tick the answer check mark, if my answer was helpful.

user3598756 · Accepted Answer · 2017-02-06 16:28:02Z

0

you can try this

Option Explicit

Sub Fruit()
    With Sheets("Source Data")
        With .Range("I3", .Cells(.Rows.count, "F").End(xlUp))
            .AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(2, .Parent.Range("A2").Value)
            FilterAndCopy .Cells, "banana", "Banana Payment"
            FilterAndCopy .Cells, "apple", "Apples Payment"
        End With
        .AutoFilterMode = False
    End With
End Sub

Sub FilterAndCopy(rng As Range, filterValue As String, destShtName As String)
    With rng
        .AutoFilter Field:=2, Criteria1:=filterValue
        If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Resize(.Rows.count - 1, 2).Offset(, 2).SpecialCells(xlCellTypeVisible).Copy Worksheets(destShtName).Range("A1")
    End With
End Sub

answered Feb 6, 2017 at 16:28

user3598756

29.5k4 gold badges20 silver badges30 bronze badges

1 Comment

user3598756 Over a year ago

@JDRows, did you get through it?

Collectives™ on Stack Overflow

VBA Returning value loop based on date and one other identifier

2 Answers 2

1 Comment

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related